ludus/janet/interpreter.janet

# 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)
)