# A tree walk interpreter for ludus (var interpret nil) (var stringify nil) (var match-pattern nil) (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 " )}) ) ) (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})) (defn- interpret* [ast ctx] (print "interpreting node " (ast :type)) (case (ast :type) :nil nil :number (ast :data) :bool (ast :data) :string (ast :data) :interpolated (interpolated ast ctx) :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) )) (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 } `) (run) )