Compare commits
2 Commits
a399669197
...
822f5c0178
Author | SHA1 | Date | |
---|---|---|---|
|
822f5c0178 | ||
|
2415f3d437 |
|
@ -1,23 +1,15 @@
|
|||
# A tree walk interpreter for ludus
|
||||
|
||||
# for repl imports
|
||||
(try (os/cd "janet") ([_] nil))
|
||||
|
||||
(import ./base :as b)
|
||||
|
||||
(var interpret nil)
|
||||
(var stringify nil)
|
||||
(var match-pattern nil)
|
||||
|
||||
(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]
|
||||
(print "resolving " name " in:")
|
||||
(pp ctx)
|
||||
|
@ -28,14 +20,14 @@
|
|||
|
||||
(defn- match-word [word value ctx]
|
||||
(def name (word :data))
|
||||
(print "matched " (stringify value) " to " name)
|
||||
(print "matched " (b/show value) " to " name)
|
||||
(set (ctx name) value)
|
||||
{:success true :ctx ctx})
|
||||
|
||||
(defn- typed [pattern value ctx]
|
||||
(def [type-ast word] (pattern :data))
|
||||
(def type (type-ast :data))
|
||||
(if (= type (ltype value))
|
||||
(if (= type (b/ludus/type value))
|
||||
(match-word word value ctx)
|
||||
{:success false :miss [pattern value]}))
|
||||
|
||||
|
@ -191,7 +183,7 @@
|
|||
(break (match-fn (inc i) value ctx)))
|
||||
(def body-ctx (match? :ctx))
|
||||
(def guard? (if guard
|
||||
(bool (interpret guard body-ctx)) true))
|
||||
(b/bool (interpret guard body-ctx)) true))
|
||||
(when (not guard?)
|
||||
(break (match-fn (inc i) value ctx)))
|
||||
(interpret expr body-ctx))
|
||||
|
@ -213,46 +205,8 @@
|
|||
(interpret (lines i) 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]
|
||||
(if (stringish? x) x (stringify (interpret x ctx)))))
|
||||
(b/stringify (interpret x ctx))))
|
||||
|
||||
(defn- interpolated [ast ctx]
|
||||
(def terms (ast :data))
|
||||
|
@ -261,7 +215,7 @@
|
|||
|
||||
(defn- iff [ast ctx]
|
||||
(def [condition then else] (ast :data))
|
||||
(if (bool (interpret condition ctx))
|
||||
(if (b/bool (interpret condition ctx))
|
||||
(interpret then ctx)
|
||||
(interpret else ctx)))
|
||||
|
||||
|
@ -271,7 +225,7 @@
|
|||
(var result :^nothing)
|
||||
(each clause clauses
|
||||
(def [lhs rhs] clause)
|
||||
(when (bool (interpret lhs ctx))
|
||||
(when (b/bool (interpret lhs ctx))
|
||||
(set result (interpret rhs ctx))
|
||||
(break)))
|
||||
(when (= result :^nothing)
|
||||
|
@ -387,7 +341,7 @@
|
|||
(print "matched!")
|
||||
(def body-ctx (match? :ctx))
|
||||
(def guard? (if guard
|
||||
(bool (interpret guard body-ctx)) true))
|
||||
(b/bool (interpret guard body-ctx)) true))
|
||||
(print "passed guard")
|
||||
(when (not guard?)
|
||||
(break (match-fn (inc i) args)))
|
||||
|
@ -400,7 +354,7 @@
|
|||
(pp curr)
|
||||
(print "to")
|
||||
(pp prev)
|
||||
(def types [(ltype prev) (ltype curr)])
|
||||
(def types [(b/ludus/type prev) (b/ludus/type curr)])
|
||||
(print "typle:")
|
||||
(pp types)
|
||||
(match types
|
||||
|
@ -503,7 +457,6 @@
|
|||
(set interpret interpret*)
|
||||
|
||||
# repl
|
||||
(try (os/cd "janet") ([_] nil))
|
||||
(import ./scanner :as s)
|
||||
(import ./parser :as p)
|
||||
(import ./validate :as v)
|
||||
|
@ -512,24 +465,16 @@
|
|||
|
||||
(defn- has-errors? [{:errors errors}] (and errors (not (empty? errors))))
|
||||
|
||||
(def base {
|
||||
"ludus-type" ltype
|
||||
"print" print
|
||||
"add" +
|
||||
"sub" -
|
||||
"stringify" stringify
|
||||
})
|
||||
|
||||
(defn run []
|
||||
(def scanned (s/scan source))
|
||||
(when (has-errors? scanned) (break (scanned :errors)))
|
||||
(def parsed (p/parse scanned))
|
||||
(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)))
|
||||
# (def cleaned (get-in parsed [:ast :data 1]))
|
||||
# (pp cleaned)
|
||||
(interpret (parsed :ast) @{:^parent base})
|
||||
(interpret (parsed :ast) @{:^parent b/ctx})
|
||||
# (try (interpret (parsed :ast) @{})
|
||||
# ([e] (print "Ludus panicked!: "
|
||||
# (if (struct? e) (error (e :msg)) (error e)))))
|
||||
|
@ -537,11 +482,9 @@
|
|||
|
||||
(do
|
||||
(set source `
|
||||
print
|
||||
|
||||
`)
|
||||
(def result (run))
|
||||
(stringify result)
|
||||
(b/show result)
|
||||
)
|
||||
|
||||
(string print)
|
||||
|
||||
|
|
|
@ -345,6 +345,7 @@ Deferred until a later iteration of Ludus:
|
|||
(def the-fn (resolve-name ctx (fn-word :data)))
|
||||
(when (not the-fn) (break validator))
|
||||
(when (= :function (type the-fn)) (break validator))
|
||||
(when (= :cfunction (type the-fn)) (break validator))
|
||||
(print "fn name: " (the-fn :name))
|
||||
(def arities (the-fn :arities))
|
||||
(print "arities: ")
|
||||
|
@ -625,7 +626,7 @@ Deferred until a later iteration of Ludus:
|
|||
(default ctx @{})
|
||||
(def validator (new-validator ast))
|
||||
(def base-ctx @{:^parent ctx})
|
||||
(set (validator :ctx) ctx)
|
||||
(set (validator :ctx) base-ctx)
|
||||
(validate validator))
|
||||
|
||||
(defn foo [] :foo)
|
||||
|
|
Loading…
Reference in New Issue
Block a user