;; Erlang sequential evaluator — tree-walking interpreter over the
;; parser AST. Phase 2 of plans/erlang-on-sx.md.
;;
;; Entry points:
;;   (erlang-eval-ast SRC)         -- parse body, eval, return last value
;;   (er-eval-expr NODE ENV)       -- evaluate one AST node
;;   (er-eval-body NODES ENV)      -- evaluate a comma-sequence, return last
;;
;; Runtime values:
;;   integers / floats      -> SX number
;;   atoms                  -> {:tag "atom" :name <string>}
;;   booleans               -> atoms 'true' / 'false'
;;   strings                -> SX string  (char-list semantics deferred)
;;   empty list             -> {:tag "nil"}
;;   cons cell              -> {:tag "cons" :head V :tail V}
;;   tuple                  -> {:tag "tuple" :elements (list V ...)}
;;
;; Environment: mutable dict from variable name (string) to value.

;; ── value constructors / predicates ────────────────────────────────
(define er-mk-atom (fn (name) {:name name :tag "atom"}))
(define er-atom-true (er-mk-atom "true"))
(define er-atom-false (er-mk-atom "false"))
(define er-mk-nil (fn () {:tag "nil"}))
(define er-mk-cons (fn (h t) {:tag "cons" :head h :tail t}))
(define er-mk-tuple (fn (elems) {:tag "tuple" :elements elems}))
(define er-bool (fn (b) (if b er-atom-true er-atom-false)))

(define
  er-is-tagged?
  (fn (v tag) (and (= (type-of v) "dict") (= (get v :tag) tag))))
(define er-atom? (fn (v) (er-is-tagged? v "atom")))
(define er-nil? (fn (v) (er-is-tagged? v "nil")))
(define er-cons? (fn (v) (er-is-tagged? v "cons")))
(define er-tuple? (fn (v) (er-is-tagged? v "tuple")))

(define
  er-is-atom-named?
  (fn (v name) (and (er-atom? v) (= (get v :name) name))))
(define er-truthy? (fn (v) (er-is-atom-named? v "true")))

;; ── environment ───────────────────────────────────────────────────
(define er-env-new (fn () {}))

(define
  er-env-lookup
  (fn
    (env name)
    (if
      (dict-has? env name)
      (get env name)
      (error (str "Erlang: unbound variable '" name "'")))))

(define er-env-bind! (fn (env name val) (dict-set! env name val)))

;; ── entry ─────────────────────────────────────────────────────────
(define
  erlang-eval-ast
  (fn
    (src)
    (let
      ((st (er-state-make (er-tokenize src))))
      (let
        ((body (er-parse-body st)) (env (er-env-new)))
        (er-eval-body body env)))))

(define
  er-eval-body
  (fn
    (exprs env)
    (let
      ((last (list nil)))
      (for-each
        (fn (i) (set-nth! last 0 (er-eval-expr (nth exprs i) env)))
        (range 0 (len exprs)))
      (nth last 0))))

;; ── dispatch ──────────────────────────────────────────────────────
(define
  er-eval-expr
  (fn
    (node env)
    (let
      ((ty (get node :type)))
      (cond
        (= ty "integer") (parse-number (get node :value))
        (= ty "float") (parse-number (get node :value))
        (= ty "atom") (er-mk-atom (get node :value))
        (= ty "string") (get node :value)
        (= ty "nil") (er-mk-nil)
        (= ty "var") (er-eval-var node env)
        (= ty "tuple") (er-eval-tuple node env)
        (= ty "cons") (er-eval-cons node env)
        (= ty "op") (er-eval-op node env)
        (= ty "unop") (er-eval-unop node env)
        (= ty "block") (er-eval-body (get node :exprs) env)
        (= ty "if") (er-eval-if node env)
        (= ty "case") (er-eval-case node env)
        (= ty "match") (er-eval-match node env)
        :else (error (str "Erlang eval: unsupported node type '" ty "'"))))))

(define
  er-eval-var
  (fn
    (node env)
    (let
      ((name (get node :name)))
      (if
        (= name "_")
        (error "Erlang: '_' cannot be used as a value")
        (er-env-lookup env name)))))

(define
  er-eval-tuple
  (fn
    (node env)
    (let
      ((out (list)))
      (for-each
        (fn
          (i)
          (append! out (er-eval-expr (nth (get node :elements) i) env)))
        (range 0 (len (get node :elements))))
      (er-mk-tuple out))))

(define
  er-eval-cons
  (fn
    (node env)
    (er-mk-cons
      (er-eval-expr (get node :head) env)
      (er-eval-expr (get node :tail) env))))

;; ── match expression ─────────────────────────────────────────────
(define
  er-eval-match
  (fn
    (node env)
    (let
      ((lhs (get node :lhs))
        (rhs-val (er-eval-expr (get node :rhs) env)))
      (if
        (er-match! lhs rhs-val env)
        rhs-val
        (error "Erlang: badmatch")))))

;; ── pattern matching ─────────────────────────────────────────────
;; Unifies PAT against VAL, binding fresh vars into ENV.
;; Returns true on success, false otherwise. On failure ENV may hold
;; partial bindings — callers trying multiple clauses must snapshot
;; ENV and restore it between attempts.
(define
  er-match!
  (fn
    (pat val env)
    (let
      ((ty (get pat :type)))
      (cond
        (= ty "var") (er-match-var pat val env)
        (= ty "integer")
        (and (= (type-of val) "number") (= (parse-number (get pat :value)) val))
        (= ty "float")
        (and (= (type-of val) "number") (= (parse-number (get pat :value)) val))
        (= ty "atom") (and (er-atom? val) (= (get val :name) (get pat :value)))
        (= ty "string")
        (and (= (type-of val) "string") (= val (get pat :value)))
        (= ty "nil") (er-nil? val)
        (= ty "tuple") (er-match-tuple pat val env)
        (= ty "cons") (er-match-cons pat val env)
        :else (error (str "Erlang match: unsupported pattern type '" ty "'"))))))

(define
  er-match-var
  (fn
    (pat val env)
    (let
      ((name (get pat :name)))
      (cond
        (= name "_") true
        (dict-has? env name) (er-equal? (get env name) val)
        :else (do (er-env-bind! env name val) true)))))

(define
  er-match-tuple
  (fn
    (pat val env)
    (and
      (er-tuple? val)
      (let
        ((ps (get pat :elements)) (vs (get val :elements)))
        (if (not (= (len ps) (len vs))) false (er-match-all ps vs 0 env))))))

(define
  er-match-all
  (fn
    (ps vs i env)
    (if
      (>= i (len ps))
      true
      (if
        (er-match! (nth ps i) (nth vs i) env)
        (er-match-all ps vs (+ i 1) env)
        false))))

(define
  er-match-cons
  (fn
    (pat val env)
    (and
      (er-cons? val)
      (and
        (er-match! (get pat :head) (get val :head) env)
        (er-match! (get pat :tail) (get val :tail) env)))))

;; ── env snapshot / restore ────────────────────────────────────────
(define
  er-env-copy
  (fn
    (env)
    (let
      ((out {}))
      (for-each (fn (k) (dict-set! out k (get env k))) (keys env))
      out)))

(define
  er-env-restore!
  (fn
    (env snap)
    (for-each (fn (k) (dict-delete! env k)) (keys env))
    (for-each (fn (k) (dict-set! env k (get snap k))) (keys snap))))

;; ── case ─────────────────────────────────────────────────────────
(define
  er-eval-case
  (fn
    (node env)
    (let
      ((subject (er-eval-expr (get node :expr) env)))
      (er-eval-case-clauses (get node :clauses) 0 subject env))))

(define
  er-eval-case-clauses
  (fn
    (clauses i subject env)
    (if
      (>= i (len clauses))
      (error "Erlang: case_clause: no matching clause")
      (let
        ((c (nth clauses i)) (snap (er-env-copy env)))
        (if
          (and
            (er-match! (get c :pattern) subject env)
            (er-eval-guards (get c :guards) env))
          (er-eval-body (get c :body) env)
          (do
            (er-env-restore! env snap)
            (er-eval-case-clauses clauses (+ i 1) subject env)))))))

;; ── operators ─────────────────────────────────────────────────────
(define
  er-eval-op
  (fn
    (node env)
    (let
      ((op (get node :op)) (args (get node :args)))
      (cond
        (= op "andalso") (er-eval-andalso args env)
        (= op "orelse") (er-eval-orelse args env)
        :else (er-apply-binop
          op
          (er-eval-expr (nth args 0) env)
          (er-eval-expr (nth args 1) env))))))

(define
  er-eval-andalso
  (fn
    (args env)
    (let
      ((a (er-eval-expr (nth args 0) env)))
      (if (er-truthy? a) (er-eval-expr (nth args 1) env) a))))

(define
  er-eval-orelse
  (fn
    (args env)
    (let
      ((a (er-eval-expr (nth args 0) env)))
      (if (er-truthy? a) a (er-eval-expr (nth args 1) env)))))

(define
  er-apply-binop
  (fn
    (op a b)
    (cond
      (= op "+") (+ a b)
      (= op "-") (- a b)
      (= op "*") (* a b)
      (= op "/") (/ a b)
      (= op "div") (truncate (/ a b))
      (= op "rem") (remainder a b)
      (= op "==") (er-bool (er-equal? a b))
      (= op "/=") (er-bool (not (er-equal? a b)))
      (= op "=:=") (er-bool (er-exact-equal? a b))
      (= op "=/=") (er-bool (not (er-exact-equal? a b)))
      (= op "<") (er-bool (er-lt? a b))
      (= op ">") (er-bool (er-lt? b a))
      (= op "=<") (er-bool (not (er-lt? b a)))
      (= op ">=") (er-bool (not (er-lt? a b)))
      (= op "++") (er-list-append a b)
      (= op "and") (er-bool (and (er-truthy? a) (er-truthy? b)))
      (= op "or") (er-bool (or (er-truthy? a) (er-truthy? b)))
      :else (error (str "Erlang eval: unsupported operator '" op "'")))))

(define
  er-eval-unop
  (fn
    (node env)
    (let
      ((op (get node :op)) (a (er-eval-expr (get node :arg) env)))
      (cond
        (= op "-") (- 0 a)
        (= op "+") a
        (= op "not") (er-bool (not (er-truthy? a)))
        :else (error (str "Erlang eval: unsupported unary '" op "'"))))))

;; ── equality / comparison ─────────────────────────────────────────
(define
  er-equal?
  (fn
    (a b)
    (cond
      (and (= (type-of a) "number") (= (type-of b) "number")) (= a b)
      (and (er-atom? a) (er-atom? b)) (= (get a :name) (get b :name))
      (and (er-nil? a) (er-nil? b)) true
      (and (er-cons? a) (er-cons? b))
      (and
        (er-equal? (get a :head) (get b :head))
        (er-equal? (get a :tail) (get b :tail)))
      (and (er-tuple? a) (er-tuple? b))
      (let
        ((ea (get a :elements)) (eb (get b :elements)))
        (and
          (= (len ea) (len eb))
          (every?
            (fn (i) (er-equal? (nth ea i) (nth eb i)))
            (range 0 (len ea)))))
      (and (= (type-of a) "string") (= (type-of b) "string")) (= a b)
      :else false)))

;; Exact equality: 1 =/= 1.0 in Erlang.
(define
  er-exact-equal?
  (fn
    (a b)
    (if
      (and (= (type-of a) "number") (= (type-of b) "number"))
      (and (= (integer? a) (integer? b)) (= a b))
      (er-equal? a b))))

(define
  er-lt?
  (fn
    (a b)
    (cond
      (and (= (type-of a) "number") (= (type-of b) "number")) (< a b)
      (and (er-atom? a) (er-atom? b)) (< (get a :name) (get b :name))
      (and (= (type-of a) "string") (= (type-of b) "string")) (< a b)
      :else (< (er-type-order a) (er-type-order b)))))

(define
  er-type-order
  (fn
    (v)
    (cond
      (= (type-of v) "number") 0
      (er-atom? v) 1
      (er-tuple? v) 2
      (er-nil? v) 3
      (er-cons? v) 3
      (= (type-of v) "string") 4
      :else 5)))

(define
  er-list-append
  (fn
    (a b)
    (cond
      (er-nil? a) b
      (er-cons? a)
      (er-mk-cons (get a :head) (er-list-append (get a :tail) b))
      :else (error "Erlang: ++ left argument is not a proper list"))))

;; ── if ────────────────────────────────────────────────────────────
(define er-eval-if (fn (node env) (er-eval-if-clauses (get node :clauses) 0 env)))

(define
  er-eval-if-clauses
  (fn
    (clauses i env)
    (if
      (>= i (len clauses))
      (error "Erlang: if: no clause matched")
      (let
        ((c (nth clauses i)))
        (if
          (er-eval-guards (get c :guards) env)
          (er-eval-body (get c :body) env)
          (er-eval-if-clauses clauses (+ i 1) env))))))

;; Guards: outer list = OR, inner list = AND. Empty outer = always pass.
(define
  er-eval-guards
  (fn
    (alts env)
    (if (= (len alts) 0) true (er-eval-guards-any alts 0 env))))

(define
  er-eval-guards-any
  (fn
    (alts i env)
    (if
      (>= i (len alts))
      false
      (if
        (er-eval-guard-conj (nth alts i) env)
        true
        (er-eval-guards-any alts (+ i 1) env)))))

(define er-eval-guard-conj (fn (conj env) (er-eval-guard-conj-iter conj 0 env)))

(define
  er-eval-guard-conj-iter
  (fn
    (conj i env)
    (if
      (>= i (len conj))
      true
      (if
        (er-truthy? (er-eval-expr (nth conj i) env))
        (er-eval-guard-conj-iter conj (+ i 1) env)
        false))))