ludus/janet/interpreter.janet

241 lines
5.7 KiB
Plaintext
Raw Normal View History

2024-05-15 00:44:54 +00:00
# A tree walk interpreter for ludus
(var interpret nil)
(var stringify nil)
(var match-pattern nil)
2024-05-15 00:44:54 +00:00
(defn- resolve-name [name ctx]
(print "resolving " name " in:")
(pp ctx)
(when (not ctx) (break :^not-found))
(if (has-key? ctx name)
(ctx name)
(resolve-name name (ctx :^parent))))
(defn- match-word [word value ctx]
(def name (word :data))
{:success true :ctx (set (ctx name) value)})
(defn- match-pattern [pattern value &opt ctx]
(default ctx @{})
(def data (pattern :data))
(case (pattern :type)
# always match
:placeholder {:success true :ctx ctx}
:ignored {:success true :ctx ctx}
:word (match-word value ctx)
# match on equality
:nil {:success (nil? value) :ctx ctx}
:bool {:success (= data value) :ctx ctx}
:number {:success (= data value) :ctx ctx}
:string {:success (= data value) :ctx ctx}
:keyword {:success (= data value) :ctx ctx}
# TODO: tuples, lists, dicts
# TODO: string-patterns
# TODO: typed
)
)
(defn- lett [ast ctx]
(def [patt expr] (ast :data))
(def value (interpret expr ctx))
(def match? (match-pattern expr value))
(if match?
(do
)
(error {:node ast :msg (string "could not match " (stringify value) " with " )})
)
)
2024-05-15 00:44:54 +00:00
(defn- script [ast ctx]
(def lines (ast :data))
(var result nil)
(each line lines
(set result (interpret line ctx)))
result)
(defn- block [ast parent]
(def lines (ast :data))
(var result nil)
(def ctx @{:^parent parent})
(each line lines
(set result (interpret line ctx)))
result)
(defn- dict-str [dict]
(string/join
(map
(fn [[k v]] (string (stringify k) " " (stringify v)))
dict)
", "))
(defn- stringify* [value]
(def typed? (when (table? value) (:^type value)))
(def type (if typed? typed? (type value)))
(case type
:nil ""
:number (string value)
:bool (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))
# XXX: pkg, fn,
))
(set stringify stringify*)
(defn- interpolated [ast ctx]
(def terms (ast :data))
(def interpolations
(map (fn [x]
(if (string? x) x (stringify (interpret x ctx))))
terms))
(string/join interpolations))
(defn- iff [ast ctx]
(def [condition then else] (ast :data))
(if (interpret condition ctx)
(interpret then ctx)
(interpret else ctx)))
(defn- whenn [ast ctx]
(def clauses (ast :data))
(var result :^nothing)
(each clause clauses
(def [lhs rhs] clause)
(when (interpret lhs ctx)
(set result (interpret rhs ctx))
(break)))
(when (= result :^nothing)
(error {:node ast :msg "no match in when"}))
result)
(defn- word [ast ctx]
(def name (ast :data))
(resolve-name name ctx))
(defn- tup [ast ctx]
(def members (ast :data))
(def the-tup @[])
(each member members
(array/push the-tup (interpret member ctx)))
(tuple ;the-tup))
(defn- sett [ast ctx]
(def members (ast :data))
(def the-set @{:^type :set})
(each member members
(def value (interpret member ctx))
(set (the-set member) true))
the-set)
(defn- list [ast ctx]
(def members (ast :data))
(def the-list @[])
(each member members
(if (= :splat (member :type))
(do
(def splatted (interpret (member :data) ctx))
(when (not= :array (type splatted))
(error {:node member :msg "cannot splat non-list into list"}))
(array/concat the-list splatted))
(array/push the-list (interpret member ctx))))
the-list)
(defn- dict [ast ctx]
(def members (ast :data))
(def the-dict @{})
(each member members
(if (= :splat (member :type))
(do
(def splatted (interpret (member :data) ctx))
(when (or
(not= :table (type splatted))
(:^type splatted))
(error {:node member :msg "cannot splat non-dict into dict"}))
(merge-into the-dict splatted))
(do
(def [key-ast value-ast] (member :data))
(def key (interpret key-ast ctx))
(def value (interpret value-ast ctx))
(set (the-dict key) value))))
the-dict)
(defn- ref [ast ctx]
(def {:data value-ast :name name} ast)
(def value (interpret value-ast ctx))
(set (ctx name) @{:^type :ref :^value value :^name name})
value)
(defn- repeatt [ast ctx]
(def [times-ast body] (ast :data))
(def times (interpret times-ast ctx))
(when (not (number? times))
(error {:node times-ast :msg (string "repeat needs a `number` of times; you gave me a " (type times))}))
(repeat times (interpret body ctx)))
(defn- panic [ast ctx]
(def info (interpret (ast :data) ctx))
(error {:node ast :msg info}))
2024-05-15 00:44:54 +00:00
(defn- interpret* [ast ctx]
(print "interpreting node " (ast :type))
2024-05-15 00:44:54 +00:00
(case (ast :type)
:nil nil
:number (ast :data)
:bool (ast :data)
:string (ast :data)
:interpolated (interpolated ast ctx)
2024-05-15 00:44:54 +00:00
:keyword (ast :data)
:if (iff ast ctx)
:block (block ast ctx)
:word (word ast ctx)
:tuple (tup ast ctx)
:list (list ast ctx)
:set (sett ast ctx)
:dict (dict ast ctx)
:when (whenn ast ctx)
:ref (ref ast ctx)
:script (script ast ctx)
:panic (panic ast ctx)
:let (lett ast ctx)
))
2024-05-15 00:44:54 +00:00
(set interpret interpret*)
# repl
(try (os/cd "janet") ([_] nil))
(import ./scanner :as s)
(import ./parser :as p)
(import ./validate :as v)
(var source nil)
(defn run []
(def scanned (s/scan source))
(def parsed (p/parse scanned))
(def validated (v/valid parsed))
(interpret (parsed :ast) @{}))
(do
(set source `
when {
3 -> :foo
true -> :bar
}
2024-05-15 00:44:54 +00:00
`)
(run)
)