# A tree walk interpreter for ludus

(var interpret nil)
(var stringify nil)
(var match-pattern nil)

(defn- ltype [value]
  (def typed? (when (table? value) (:^type value)))
  (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)
  (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))
  (print "matched " (stringify 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))
    (match-word word value ctx)
    {:success false :miss [pattern value]}))

(defn- match-tuple [pattern value ctx]
  (when (not (tuple? value))
    (break {:success false :miss [pattern value]}))
  (def val-len (length value))
  (var members (pattern :data))
  (def patt-len (length members))
  (var splat nil)
  (def splat? (= :splat ((last members) :type)))
  (when splat?
    (when (< val-len patt-len)
      (print "mismatched splatted tuple lengths")
      (break {:success false :miss [pattern value]}))
    (print "splat!")
    (set splat (last members))
    (set members (slice members 0 (dec patt-len))))
  (when (and (not splat?) (not= val-len patt-len))
    (print "mismatched tuple lengths")
    (break {:success false :miss [pattern value]}))
  (var curr-mem :^nothing)
  (var curr-val :^nothing)
  (var success true)
  (for i 0 (length members)
    (set curr-mem (get members i))
    (set curr-val (get value i))
    (print "in tuple, matching " curr-val " with ")
    (pp curr-mem)
    (def match? (match-pattern curr-mem curr-val ctx))
    (pp match?)
    (when (not (match? :success))
      (set success false)
      (break)))
  (when (and splat? (splat :data))
    (def rest (array/slice value (length members)))
    (match-word (splat :data) rest ctx))
  (if success
    {:success true :ctx ctx}
    {:success false :miss [pattern value]}))

(defn- match-list [pattern value ctx]
  (when (not (array? value))
    (break {:success false :miss [pattern value]}))
  (def val-len (length value))
  (var members (pattern :data))
  (def patt-len (length members))
  (var splat nil)
  (def splat? (= :splat ((last members) :type)))
  (when splat?
    (when (< val-len patt-len)
      (print "mismatched splatted list lengths")
      (break {:success false :miss [pattern value]}))
    (print "splat!")
    (set splat (last members))
    (set members (slice members 0 (dec patt-len))))
  (when (and (not splat?) (not= val-len patt-len))
    (print "mismatched list lengths")
    (break {:success false :miss [pattern value]}))
  (var curr-mem :^nothing)
  (var curr-val :^nothing)
  (var success true)
  (for i 0 (length members)
    (set curr-mem (get members i))
    (set curr-val (get value i))
    (print "in list, matching " curr-val " with ")
    (pp curr-mem)
    (def match? (match-pattern curr-mem curr-val ctx))
    (pp match?)
    (when (not (match? :success))
      (set success false)
      (break)))
  (when (and splat? (splat :data))
    (def rest (array/slice value (length members)))
    (match-word (splat :data) rest ctx))
  (if success
    {:success true :ctx ctx}
    {:success false :miss [pattern value]}))

(defn- match-string [pattern value ctx]
  (when (not (string? value))
    (break {:success false :miss [pattern value]}))
  (def {:compiled compiled :bindings bindings} pattern)
  (print "matching " value " with")
  (pp (pattern :grammar))
  (def matches (peg/match compiled value))
  (when (not matches) 
    (break {:success false :miss [pattern value]}))
  (when (not= (length matches) (length bindings))
    (error "oops: different number of matches and bindings"))
  (for i 0 (length matches)
    (set (ctx (bindings i)) (matches i)))
  {:success true :ctx ctx})

(defn- match-pattern* [pattern value &opt ctx]
  (print "in match-pattern, matching " value " with:")
  (pp pattern)
  (default ctx @{})
  (def data (pattern :data))
  (case (pattern :type)
    # always match
    :placeholder {:success true :ctx ctx}
    :ignored {:success true :ctx ctx}
    :word (match-word pattern 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: lists, dicts
    :tuple (match-tuple pattern value ctx)
    :list (match-list pattern value ctx)
    # TODO: string-patterns
    :interpolated (match-string pattern value ctx)

    :typed (typed pattern value ctx)
  ))

(set match-pattern match-pattern*)

(defn- lett [ast ctx]
  (def [patt expr] (ast :data))
  (def value (interpret expr ctx))
  (def match? (match-pattern patt value))
  (if (match? :success)
    (do
      (merge-into ctx (match? :ctx))
      (print "new ctx:")
      (pp ctx)
      value)
    # TODO: represent patterns textually in errors
    (error {:node ast 
      :msg (string "could not match " (stringify value))})))

(defn- matchh [ast ctx]
  (def [to-match clauses] (ast :data))
  (def value (interpret to-match ctx))
  (var result :^nothing)
  (each clause clauses
    (def [patt guard expr] clause)
    (print "matching ")
    (pp patt)
    (def match? (match-pattern patt value))
    (when (match? :success)
      (def inner-ctx (match? :ctx))
      (def guard? (if (bool guard)
        (interpret guard inner-ctx) true))
      (when guard?
        (set result (interpret expr inner-ctx))
        (break))))
  (if (= result :^nothing)
    (error {:node ast :value value :msg "no match"})
    result))

(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)))
  (print "stringifying " (string value))
  (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))
    # XXX: pkg, fn 
  ))

(set stringify stringify*)

(defn- stringish? [x] (or (string? x) (buffer? x)))

(defn- interpolated [ast ctx]
  (def terms (ast :data))
  (each term terms (pp term))
  (def interpolations
    (map (fn [x]
      (if (stringish? x) x (stringify (interpret x ctx))))
      terms))
  (string/join interpolations))


(defn- iff [ast ctx]
  (def [condition then else] (ast :data))
  (if (bool (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 (bool (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)
    # literals
    :nil :^nil
    :number (ast :data)
    :bool (ast :data)
    :string (ast :data)
    :keyword (ast :data)

    # collections
    :tuple (tup ast ctx)
    :list (list ast ctx)
    :set (sett ast ctx)
    :dict (dict ast ctx)

    # composite forms
    :if (iff ast ctx)
    :block (block ast ctx)
    :when (whenn ast ctx)
    :script (script ast ctx)
    :panic (panic ast ctx)

    # named/naming forms
    :word (word ast ctx)
    :interpolated (interpolated ast ctx)
    :ref (ref ast ctx)
    # :ns (ns ast ctx)
    # :pkg (pkg ast ctx)

    # patterned forms
    :let (lett ast ctx)
    :match (matchh ast ctx)
    # :with (withh ast ctx)

    # functions
    # :fn (fnn ast ctx)

    # synthetic
    # :synthetic (synthetic 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- has-errors? [{:errors errors}] (and errors (not (empty? errors))))

(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))
  (when (has-errors? validated) (break (validated :errors)))
  (interpret (parsed :ast) @{})
  # (try (interpret (parsed :ast) @{})
  #   ([e] (print "Ludus panicked!: " 
  #     (if (struct? e) (error (e :msg)) (error e)))))
  )

(do 
(set source `
let verb = "love"
"{verb}"
`)
(run)
)