{stringify, ltype} -> imports from base
This commit is contained in:
parent
2415f3d437
commit
822f5c0178
|
@ -1,23 +1,15 @@
|
||||||
# A tree walk interpreter for ludus
|
# A tree walk interpreter for ludus
|
||||||
|
|
||||||
|
# for repl imports
|
||||||
|
(try (os/cd "janet") ([_] nil))
|
||||||
|
|
||||||
|
(import ./base :as b)
|
||||||
|
|
||||||
(var interpret nil)
|
(var interpret nil)
|
||||||
(var stringify nil)
|
|
||||||
(var match-pattern nil)
|
(var match-pattern nil)
|
||||||
|
|
||||||
(defn- todo [msg] (error (string "not yet implemented: " msg)))
|
(defn- todo [msg] (error (string "not yet implemented: " msg)))
|
||||||
|
|
||||||
(defn- ltype [value]
|
|
||||||
(def typed? (when (dictionary? value) (value :^type)))
|
|
||||||
(def the-type (if typed? typed? (type value)))
|
|
||||||
(case the-type
|
|
||||||
:boolean :bool
|
|
||||||
:array :list
|
|
||||||
:table :dict
|
|
||||||
the-type))
|
|
||||||
|
|
||||||
(defn- bool [value]
|
|
||||||
(if (= value :^nil nil) value))
|
|
||||||
|
|
||||||
(defn- resolve-name [name ctx]
|
(defn- resolve-name [name ctx]
|
||||||
(print "resolving " name " in:")
|
(print "resolving " name " in:")
|
||||||
(pp ctx)
|
(pp ctx)
|
||||||
|
@ -28,14 +20,14 @@
|
||||||
|
|
||||||
(defn- match-word [word value ctx]
|
(defn- match-word [word value ctx]
|
||||||
(def name (word :data))
|
(def name (word :data))
|
||||||
(print "matched " (stringify value) " to " name)
|
(print "matched " (b/show value) " to " name)
|
||||||
(set (ctx name) value)
|
(set (ctx name) value)
|
||||||
{:success true :ctx ctx})
|
{:success true :ctx ctx})
|
||||||
|
|
||||||
(defn- typed [pattern value ctx]
|
(defn- typed [pattern value ctx]
|
||||||
(def [type-ast word] (pattern :data))
|
(def [type-ast word] (pattern :data))
|
||||||
(def type (type-ast :data))
|
(def type (type-ast :data))
|
||||||
(if (= type (ltype value))
|
(if (= type (b/ludus/type value))
|
||||||
(match-word word value ctx)
|
(match-word word value ctx)
|
||||||
{:success false :miss [pattern value]}))
|
{:success false :miss [pattern value]}))
|
||||||
|
|
||||||
|
@ -191,7 +183,7 @@
|
||||||
(break (match-fn (inc i) value ctx)))
|
(break (match-fn (inc i) value ctx)))
|
||||||
(def body-ctx (match? :ctx))
|
(def body-ctx (match? :ctx))
|
||||||
(def guard? (if guard
|
(def guard? (if guard
|
||||||
(bool (interpret guard body-ctx)) true))
|
(b/bool (interpret guard body-ctx)) true))
|
||||||
(when (not guard?)
|
(when (not guard?)
|
||||||
(break (match-fn (inc i) value ctx)))
|
(break (match-fn (inc i) value ctx)))
|
||||||
(interpret expr body-ctx))
|
(interpret expr body-ctx))
|
||||||
|
@ -213,46 +205,8 @@
|
||||||
(interpret (lines i) ctx))
|
(interpret (lines i) ctx))
|
||||||
(interpret last-line ctx))
|
(interpret last-line ctx))
|
||||||
|
|
||||||
(defn- dict-str [dict]
|
|
||||||
(string/join
|
|
||||||
(map
|
|
||||||
(fn [[k v]] (string (stringify k) " " (stringify v)))
|
|
||||||
(pairs dict))
|
|
||||||
", "))
|
|
||||||
|
|
||||||
(defn- stringify* [value]
|
|
||||||
(print "stringifying " (string value))
|
|
||||||
(def typed? (when (dictionary? value)
|
|
||||||
(print "value is a dictionary")
|
|
||||||
(value :^type)))
|
|
||||||
(def type (if typed? typed? (type value)))
|
|
||||||
(print "value of type " type)
|
|
||||||
(case type
|
|
||||||
:nil ""
|
|
||||||
:number (string value)
|
|
||||||
:boolean (string value)
|
|
||||||
:keyword (string ":" value)
|
|
||||||
:string value
|
|
||||||
:tuple
|
|
||||||
(string/join (map stringify value) ", ")
|
|
||||||
:array
|
|
||||||
(string/join (map stringify value) ", ")
|
|
||||||
:table (dict-str value)
|
|
||||||
:set
|
|
||||||
(string/join (map stringify (keys value)) ", ")
|
|
||||||
:ref (stringify (value :^value))
|
|
||||||
:fn (string "fn " (value :name))
|
|
||||||
:function (string "builtin " (string value))
|
|
||||||
:cfunction (string "builtin " (string value))
|
|
||||||
# XXX: pkg, fn
|
|
||||||
))
|
|
||||||
|
|
||||||
(set stringify stringify*)
|
|
||||||
|
|
||||||
(defn- stringish? [x] (or (string? x) (buffer? x)))
|
|
||||||
|
|
||||||
(defn- to_string [ctx] (fn [x]
|
(defn- to_string [ctx] (fn [x]
|
||||||
(if (stringish? x) x (stringify (interpret x ctx)))))
|
(b/stringify (interpret x ctx))))
|
||||||
|
|
||||||
(defn- interpolated [ast ctx]
|
(defn- interpolated [ast ctx]
|
||||||
(def terms (ast :data))
|
(def terms (ast :data))
|
||||||
|
@ -261,7 +215,7 @@
|
||||||
|
|
||||||
(defn- iff [ast ctx]
|
(defn- iff [ast ctx]
|
||||||
(def [condition then else] (ast :data))
|
(def [condition then else] (ast :data))
|
||||||
(if (bool (interpret condition ctx))
|
(if (b/bool (interpret condition ctx))
|
||||||
(interpret then ctx)
|
(interpret then ctx)
|
||||||
(interpret else ctx)))
|
(interpret else ctx)))
|
||||||
|
|
||||||
|
@ -271,7 +225,7 @@
|
||||||
(var result :^nothing)
|
(var result :^nothing)
|
||||||
(each clause clauses
|
(each clause clauses
|
||||||
(def [lhs rhs] clause)
|
(def [lhs rhs] clause)
|
||||||
(when (bool (interpret lhs ctx))
|
(when (b/bool (interpret lhs ctx))
|
||||||
(set result (interpret rhs ctx))
|
(set result (interpret rhs ctx))
|
||||||
(break)))
|
(break)))
|
||||||
(when (= result :^nothing)
|
(when (= result :^nothing)
|
||||||
|
@ -387,7 +341,7 @@
|
||||||
(print "matched!")
|
(print "matched!")
|
||||||
(def body-ctx (match? :ctx))
|
(def body-ctx (match? :ctx))
|
||||||
(def guard? (if guard
|
(def guard? (if guard
|
||||||
(bool (interpret guard body-ctx)) true))
|
(b/bool (interpret guard body-ctx)) true))
|
||||||
(print "passed guard")
|
(print "passed guard")
|
||||||
(when (not guard?)
|
(when (not guard?)
|
||||||
(break (match-fn (inc i) args)))
|
(break (match-fn (inc i) args)))
|
||||||
|
@ -400,7 +354,7 @@
|
||||||
(pp curr)
|
(pp curr)
|
||||||
(print "to")
|
(print "to")
|
||||||
(pp prev)
|
(pp prev)
|
||||||
(def types [(ltype prev) (ltype curr)])
|
(def types [(b/ludus/type prev) (b/ludus/type curr)])
|
||||||
(print "typle:")
|
(print "typle:")
|
||||||
(pp types)
|
(pp types)
|
||||||
(match types
|
(match types
|
||||||
|
@ -503,7 +457,6 @@
|
||||||
(set interpret interpret*)
|
(set interpret interpret*)
|
||||||
|
|
||||||
# repl
|
# repl
|
||||||
(try (os/cd "janet") ([_] nil))
|
|
||||||
(import ./scanner :as s)
|
(import ./scanner :as s)
|
||||||
(import ./parser :as p)
|
(import ./parser :as p)
|
||||||
(import ./validate :as v)
|
(import ./validate :as v)
|
||||||
|
@ -512,24 +465,16 @@
|
||||||
|
|
||||||
(defn- has-errors? [{:errors errors}] (and errors (not (empty? errors))))
|
(defn- has-errors? [{:errors errors}] (and errors (not (empty? errors))))
|
||||||
|
|
||||||
(def base {
|
|
||||||
"ludus-type" ltype
|
|
||||||
"print" print
|
|
||||||
"add" +
|
|
||||||
"sub" -
|
|
||||||
"stringify" stringify
|
|
||||||
})
|
|
||||||
|
|
||||||
(defn run []
|
(defn run []
|
||||||
(def scanned (s/scan source))
|
(def scanned (s/scan source))
|
||||||
(when (has-errors? scanned) (break (scanned :errors)))
|
(when (has-errors? scanned) (break (scanned :errors)))
|
||||||
(def parsed (p/parse scanned))
|
(def parsed (p/parse scanned))
|
||||||
(when (has-errors? parsed) (break (parsed :errors)))
|
(when (has-errors? parsed) (break (parsed :errors)))
|
||||||
(def validated (v/valid parsed base))
|
(def validated (v/valid parsed b/ctx))
|
||||||
(when (has-errors? validated) (break (validated :errors)))
|
(when (has-errors? validated) (break (validated :errors)))
|
||||||
# (def cleaned (get-in parsed [:ast :data 1]))
|
# (def cleaned (get-in parsed [:ast :data 1]))
|
||||||
# (pp cleaned)
|
# (pp cleaned)
|
||||||
(interpret (parsed :ast) @{:^parent base})
|
(interpret (parsed :ast) @{:^parent b/ctx})
|
||||||
# (try (interpret (parsed :ast) @{})
|
# (try (interpret (parsed :ast) @{})
|
||||||
# ([e] (print "Ludus panicked!: "
|
# ([e] (print "Ludus panicked!: "
|
||||||
# (if (struct? e) (error (e :msg)) (error e)))))
|
# (if (struct? e) (error (e :msg)) (error e)))))
|
||||||
|
@ -537,11 +482,9 @@
|
||||||
|
|
||||||
(do
|
(do
|
||||||
(set source `
|
(set source `
|
||||||
print
|
|
||||||
`)
|
`)
|
||||||
(def result (run))
|
(def result (run))
|
||||||
(stringify result)
|
(b/show result)
|
||||||
)
|
)
|
||||||
|
|
||||||
(string print)
|
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue
Block a user