;; lib/ocaml/eval.sx — OCaml AST evaluator (Phase 2 slice).
;;
;; Walks the AST produced by ocaml-parse / ocaml-parse-program and yields
;; SX values.
;;
;; Coverage in this slice:
;;   atoms     int/float/string/char/bool/unit
;;   :var      env lookup
;;   :app      curried application
;;   :op       arithmetic, comparison, boolean, ^ string concat, mod, ::
;;   :neg      unary minus
;;   :not      boolean negation
;;   :if       conditional
;;   :seq      sequence — discard all but last
;;   :tuple    SX (:tuple v1 v2 …)
;;   :list     SX list
;;   :fun      closure (auto-curried via host SX lambda)
;;   :let      non-recursive binding
;;   :let-rec  recursive binding for function values (mutable ref cell)
;;
;; Out of scope: pattern matching, refs (`ref`/`!`/`:=`), modules, ADTs,
;; mutable records, for/while, try/with.
;;
;; Environment representation: an assoc list of (name value) pairs. Most
;; recent binding shadows older ones.

;; Initial environment provides OCaml stdlib functions that are values,
;; not language keywords (e.g. `not`, `succ`, `pred`). Phase 6 adds the
;; full stdlib slice; this just unblocks Phase 2 tests.
(define ocaml-empty-env
  (fn ()
    (list
      (list "not"  (fn (x) (not x)))
      (list "succ" (fn (x) (+ x 1)))
      (list "pred" (fn (x) (- x 1)))
      (list "abs"  (fn (x) (if (< x 0) (- 0 x) x)))
      (list "max"  (fn (a) (fn (b) (if (> a b) a b))))
      (list "min"  (fn (a) (fn (b) (if (< a b) a b))))
      (list "fst"  (fn (p) (nth p 1)))
      (list "snd"  (fn (p) (nth p 2)))
      (list "ignore" (fn (x) nil))
      ;; References. A ref cell is a one-element list; ! reads it and
      ;; := mutates it via set-nth!.
      (list "ref" (fn (x) (list x)))
      ;; Exceptions: `raise e` invokes the host-SX raise; values are
      ;; tagged like other ctors so `try ... with | Exn x -> handler`
      ;; can pattern-match them.
      (list "raise" (fn (e) (raise e)))
      (list "failwith" (fn (msg) (raise (list "Failure" msg))))
      (list "invalid_arg" (fn (msg) (raise (list "Invalid_argument" msg)))
      )
      ;; Host primitives exposed for the OCaml stdlib (lib/ocaml/runtime.sx).
      ;; Underscore-prefixed to avoid clashing with user names.
      (list "_string_length" (fn (s) (len s)))
      (list "_string_get"    (fn (s) (fn (i) (nth s i))))
      (list "_string_sub"    (fn (s) (fn (i) (fn (n) (slice s i (+ i n))))))
      (list "_string_concat" (fn (sep) (fn (xs) (join sep xs))))
      (list "_string_upper"  (fn (s) (upper s)))
      (list "_string_lower"  (fn (s) (lower s)))
      (list "_string_starts_with" (fn (p) (fn (s) (starts-with? s p))))
      (list "_string_ends_with"   (fn (p) (fn (s) (ends-with? s p))))
      (list "_string_contains"    (fn (s) (fn (sub) (contains? s sub))))
      (list "_string_trim"        (fn (s) (trim s)))
      (list "_string_split_on_char"
        (fn (sep) (fn (s) (split s sep))))
      (list "_string_replace"
        (fn (s) (fn (a) (fn (b) (replace s a b)))))
      (list "_string_index_of"
        (fn (s) (fn (sub) (index-of s sub))))
      (list "_int_of_string" (fn (s) (parse-number s)))
      (list "_string_of_int" (fn (i) (str i)))
      (list "_string_of_float" (fn (f) (str f)))
      ;; Integer formatting helpers used by Printf %x/%X/%o.
      (list "_int_to_hex_lower"
        (fn (n)
          (cond
            ((= n 0) "0")
            (else
              (let ((digits "0123456789abcdef")
                    (m (if (< n 0) (- 0 n) n))
                    (out ""))
                (begin
                  (define loop
                    (fn ()
                      (when (> m 0)
                        (begin
                          (set! out (str (nth digits (mod m 16)) out))
                          (set! m (floor (/ m 16)))
                          (loop)))))
                  (loop)
                  (if (< n 0) (str "-" out) out)))))))
      (list "_int_to_hex_upper"
        (fn (n)
          (cond
            ((= n 0) "0")
            (else
              (let ((digits "0123456789ABCDEF")
                    (m (if (< n 0) (- 0 n) n))
                    (out ""))
                (begin
                  (define loop
                    (fn ()
                      (when (> m 0)
                        (begin
                          (set! out (str (nth digits (mod m 16)) out))
                          (set! m (floor (/ m 16)))
                          (loop)))))
                  (loop)
                  (if (< n 0) (str "-" out) out)))))))
      (list "_int_to_octal"
        (fn (n)
          (cond
            ((= n 0) "0")
            (else
              (let ((digits "01234567")
                    (m (if (< n 0) (- 0 n) n))
                    (out ""))
                (begin
                  (define loop
                    (fn ()
                      (when (> m 0)
                        (begin
                          (set! out (str (nth digits (mod m 8)) out))
                          (set! m (floor (/ m 8)))
                          (loop)))))
                  (loop)
                  (if (< n 0) (str "-" out) out)))))))
      (list "_char_code" (fn (c) (char-code c)))
      (list "_char_chr"  (fn (n) (char-from-code n)))
      ;; Print: route to host SX `display` (no automatic newline).
      (list "print_string"  (fn (s) (begin (display s) nil)))
      (list "print_endline" (fn (s) (begin (display s) (display "\n") nil)))
      (list "print_int"     (fn (i) (begin (display (str i)) nil)))
      (list "print_newline" (fn (_) (begin (display "\n") nil)))
      ;; Float math primitives.
      (list "_float_sqrt" (fn (x) (sqrt x)))
      (list "_float_sin"  (fn (x) (sin x)))
      (list "_float_cos"  (fn (x) (cos x)))
      (list "_float_pow"  (fn (a) (fn (b) (pow a b))))
      (list "_float_floor" (fn (x) (floor x)))
      (list "_float_ceil"  (fn (x) (ceil x)))
      (list "_float_round" (fn (x) (round x)))
      ;; Polymorphic compare — returns negative / 0 / positive like
      ;; OCaml's Stdlib.compare. Defers to host SX `<` and `>`.
      (list "compare"
        (fn (a) (fn (b)
          (cond
            ((< a b) -1)
            ((> a b) 1)
            (else 0)))))
      ;; Hashtbl primitives (one-element list cell holding a dict).
      ;; Keys are coerced to strings via `str` so any value type works
      ;; as a key (matches Hashtbl's polymorphic-key semantics).
      (list "_hashtbl_create" (fn (n) (list {})))
      (list "_hashtbl_add"
        (fn (t) (fn (k) (fn (v)
          (begin
            (set-nth! t 0 (merge (nth t 0) (dict (str k) v)))
            nil)))))
      (list "_hashtbl_replace"
        (fn (t) (fn (k) (fn (v)
          (begin
            (set-nth! t 0 (merge (nth t 0) (dict (str k) v)))
            nil)))))
      (list "_hashtbl_find_opt"
        (fn (t) (fn (k)
          (cond
            ((has-key? (nth t 0) (str k)) (list "Some" (get (nth t 0) (str k))))
            (else (list "None"))))))
      (list "_hashtbl_mem"
        (fn (t) (fn (k) (has-key? (nth t 0) (str k)))))
      (list "_hashtbl_length"
        (fn (t) (len (keys (nth t 0)))))
      (list "_hashtbl_remove"
        (fn (t) (fn (k)
          (let ((d (nth t 0)))
            (begin
              (set-nth! t 0 (dissoc d (str k)))
              nil)))))
      (list "_hashtbl_clear"
        (fn (t)
          (begin
            (set-nth! t 0 {})
            nil)))
      ;; _lazy_force: evaluate the thunk on first force, cache result.
      ;; cell: one-elt list whose value is ("Thunk" expr env) or
      ;; ("Forced" v).
      (list "_lazy_force"
        (fn (cell)
          (let ((state (nth cell 0)))
            (cond
              ((= (first state) "Forced") (nth state 1))
              (else
                (let ((expr (nth state 1)) (env (nth state 2)))
                  (let ((v (ocaml-eval expr env)))
                    (begin
                      (set-nth! cell 0 (list "Forced" v))
                      v))))))))
      ;; _hashtbl_to_list: returns [(k, v); ...] as a list of pairs.
      ;; Keys are returned as the stringified form used internally.
      (list "_hashtbl_to_list"
        (fn (t)
          (let ((d (nth t 0)) (out (list)))
            (begin
              (define ks (keys d))
              (define loop
                (fn (xs)
                  (when (not (= xs (list)))
                    (begin
                      (append! out
                        (list "tuple" (first xs) (get d (first xs))))
                      (loop (rest xs))))))
              (loop ks)
              out)))))))

(define ocaml-env-lookup
  (fn (env name)
    (cond
      ((= env (list)) nil)
      ((= (first (first env)) name) (nth (first env) 1))
      (else (ocaml-env-lookup (rest env) name)))))

(define ocaml-env-has?
  (fn (env name)
    (cond
      ((= env (list)) false)
      ((= (first (first env)) name) true)
      (else (ocaml-env-has? (rest env) name)))))

(define ocaml-env-extend
  (fn (env name val)
    (cons (list name val) env)))

;; Resolve a module path / functor-application expression to a module dict.
;; Mirrors the field-access escape hatch where `(:con NAME)` is treated as
;; an env lookup rather than a nullary ctor; also handles `(:app FN ARG)`
;; for functor applications, `(:field …)` for sub-modules, and `(:var …)`
;; for lower-case bindings.
(define ocaml-resolve-module-path
  (fn (path-expr env)
    (let ((tag (ocaml-tag-of path-expr)))
      (cond
        ((= tag "con")
          (cond
            ((ocaml-env-has? env (nth path-expr 1))
              (ocaml-env-lookup env (nth path-expr 1)))
            (else (error (str "ocaml-eval: unknown module " (nth path-expr 1))))))
        ((= tag "var")
          (cond
            ((ocaml-env-has? env (nth path-expr 1))
              (ocaml-env-lookup env (nth path-expr 1)))
            (else (error (str "ocaml-eval: unknown module-var " (nth path-expr 1))))))
        ((= tag "field")
          (let ((parent (ocaml-resolve-module-path (nth path-expr 1) env)))
            (cond
              ((dict? parent) (get parent (nth path-expr 2)))
              (else (error
                (str "ocaml-eval: not a module on path: " parent))))))
        ((= tag "app")
          (let ((fn-val (ocaml-resolve-module-path (nth path-expr 1) env))
                (arg-val (ocaml-resolve-module-path (nth path-expr 2) env)))
            (fn-val arg-val)))
        ((= tag "unit") {})
        (else (ocaml-eval path-expr env))))))

;; Merge a dict's bindings into an env (used by `open`/`include`).
;; Iterates keys; each (k, get d k) becomes a fresh env binding.
(define ocaml-env-merge-dict
  (fn (env d)
    (let ((result env) (ks (keys d)))
      (begin
        (define loop
          (fn (xs)
            (when (not (= xs (list)))
              (let ((k (first xs)))
                (begin
                  (set! result (cons (list k (get d k)) result))
                  (loop (rest xs)))))))
        (loop ks)
        result))))

(define ocaml-tag-of (fn (ast) (nth ast 0)))

(define ocaml-eval (fn (ast env) nil))

;; Pattern matcher — returns the extended env on success, or :fail on
;; mismatch (using the keyword :fail so nil values don't ambiguate).
;;
;; Pattern shapes (from parser):
;;   (:pwild)                  match anything, no binding
;;   (:pvar NAME)              match anything, bind NAME → val
;;   (:plit LITAST)            literal compare
;;   (:pcon NAME PATS...)      ctor: val must be (NAME ARGS...) and arity match
;;   (:pcons HEAD TAIL)        non-empty list: match head + tail
;;   (:plist PATS...)          list of exact length, item-wise match
;;   (:ptuple PATS...)         val must be ("tuple" ITEMS...) of same arity
(define ocaml-match-fail :fail)

(define ocaml-eval-lit
  (fn (lit-ast)
    (let ((tag (nth lit-ast 0)))
      (cond
        ((= tag "int")    (nth lit-ast 1))
        ((= tag "float")  (nth lit-ast 1))
        ((= tag "string") (nth lit-ast 1))
        ((= tag "char")   (nth lit-ast 1))
        ((= tag "bool")   (nth lit-ast 1))
        ((= tag "unit")   nil)
        (else (error (str "ocaml-eval-lit: bad literal " tag)))))))

(define ocaml-match-pat (fn (pat val env) ocaml-match-fail))

(define ocaml-match-list
  (fn (pats vals env)
    (cond
      ((and (= (len pats) 0) (= (len vals) 0)) env)
      ((or (= (len pats) 0) (= (len vals) 0)) ocaml-match-fail)
      (else
        (let ((env2 (ocaml-match-pat (first pats) (first vals) env)))
          (cond
            ((= env2 ocaml-match-fail) ocaml-match-fail)
            (else (ocaml-match-list (rest pats) (rest vals) env2))))))))

(set! ocaml-match-pat
  (fn (pat val env)
    (let ((tag (nth pat 0)))
      (cond
        ((= tag "pwild") env)
        ((= tag "pvar")
          (ocaml-env-extend env (nth pat 1) val))
        ((= tag "plit")
          (if (= (ocaml-eval-lit (nth pat 1)) val) env ocaml-match-fail))
        ((= tag "precord")
          ;; (:precord (FIELDNAME PAT) ...) — val must be a dict with each
          ;; named field; each pat must match the field's value.
          (cond
            ((not (dict? val)) ocaml-match-fail)
            (else
              (let ((fields (rest pat)) (env-cur env) (failed false))
                (begin
                  (define one-field
                    (fn (kv)
                      (let ((k (first kv)) (p (nth kv 1)))
                        (cond
                          ((not (has-key? val k))
                            (set! failed true))
                          (else
                            (let ((env2 (ocaml-match-pat p (get val k) env-cur)))
                              (cond
                                ((= env2 ocaml-match-fail) (set! failed true))
                                (else (set! env-cur env2)))))))))
                  (define loop
                    (fn (xs)
                      (when (and (not failed) (not (= xs (list))))
                        (begin (one-field (first xs)) (loop (rest xs))))))
                  (loop fields)
                  (cond
                    (failed ocaml-match-fail)
                    (else env-cur)))))))
        ((= tag "pcon")
          ;; (:pcon NAME PATS...) — val must be (NAME VALS...) with same arity.
          (let ((name (nth pat 1)) (arg-pats (rest (rest pat))))
            (cond
              ((and (list? val) (not (empty? val)) (= (first val) name)
                    (= (len (rest val)) (len arg-pats)))
                (ocaml-match-list arg-pats (rest val) env))
              (else ocaml-match-fail))))
        ((= tag "por")
          ;; (:por ALT1 ALT2 ...) — try each alternative; succeed on the
          ;; first match. Note: for now, alternatives must bind the same
          ;; set of variables (OCaml constraint) — we don't enforce this.
          (let ((alts (rest pat)) (result ocaml-match-fail) (done false))
            (begin
              (define try-alts
                (fn (xs)
                  (when (and (not done) (not (= xs (list))))
                    (let ((env2 (ocaml-match-pat (first xs) val env)))
                      (cond
                        ((not (= env2 ocaml-match-fail))
                          (begin (set! result env2) (set! done true)))
                        (else (try-alts (rest xs))))))))
              (try-alts alts)
              result)))
        ((= tag "pas")
          ;; (:pas INNER NAME) — match inner pattern, also bind NAME → val.
          (let ((inner (nth pat 1)) (alias (nth pat 2)))
            (let ((env2 (ocaml-match-pat inner val env)))
              (cond
                ((= env2 ocaml-match-fail) ocaml-match-fail)
                (else (ocaml-env-extend env2 alias val))))))
        ((= tag "pcons")
          ;; (:pcons HEAD TAIL) — val must be a non-empty list.
          (cond
            ((and (list? val) (not (empty? val))
                  (not (and (not (empty? val)) (string? (first val)))))
              ;; OCaml lists are SX lists (not tagged like ctors). Match
              ;; head pattern against (first val), tail against (rest val).
              (let ((env2 (ocaml-match-pat (nth pat 1) (first val) env)))
                (cond
                  ((= env2 ocaml-match-fail) ocaml-match-fail)
                  (else (ocaml-match-pat (nth pat 2) (rest val) env2)))))
            ;; Allow lists whose first element happens to be a string —
            ;; ambiguous with ctors; treat them as plain lists.
            ((and (list? val) (not (empty? val)))
              (let ((env2 (ocaml-match-pat (nth pat 1) (first val) env)))
                (cond
                  ((= env2 ocaml-match-fail) ocaml-match-fail)
                  (else (ocaml-match-pat (nth pat 2) (rest val) env2)))))
            (else ocaml-match-fail)))
        ((= tag "plist")
          ;; (:plist PATS...) — val must be a list of exact length.
          (let ((item-pats (rest pat)))
            (cond
              ((and (list? val) (= (len val) (len item-pats)))
                (ocaml-match-list item-pats val env))
              (else ocaml-match-fail))))
        ((= tag "ptuple")
          (let ((item-pats (rest pat)))
            (cond
              ((and (list? val) (not (empty? val))
                    (= (first val) "tuple")
                    (= (len (rest val)) (len item-pats)))
                (ocaml-match-list item-pats (rest val) env))
              (else ocaml-match-fail))))
        (else (error (str "ocaml-match-pat: unknown pattern tag " tag)))))))

(define ocaml-match-clauses
  (fn (val clauses env)
    (begin
      (define try-clauses
        (fn (cs)
          (cond
            ((empty? cs)
              (error (str "ocaml-eval: match failure on " val)))
            (else
              (let ((clause (first cs)))
                (let ((ctag (nth clause 0)))
                  (cond
                    ((= ctag "case")
                      (let ((pat (nth clause 1)) (body (nth clause 2)))
                        (let ((env2 (ocaml-match-pat pat val env)))
                          (cond
                            ((= env2 ocaml-match-fail) (try-clauses (rest cs)))
                            (else (ocaml-eval body env2))))))
                    ((= ctag "case-when")
                      (let ((pat (nth clause 1))
                            (guard (nth clause 2))
                            (body (nth clause 3)))
                        (let ((env2 (ocaml-match-pat pat val env)))
                          (cond
                            ((= env2 ocaml-match-fail) (try-clauses (rest cs)))
                            ((not (ocaml-eval guard env2)) (try-clauses (rest cs)))
                            (else (ocaml-eval body env2))))))
                    (else (error (str "ocaml-match: bad clause tag " ctag))))))))))
      (try-clauses clauses))))

(define ocaml-match-eval
  (fn (scrut-ast clauses env)
    (ocaml-match-clauses (ocaml-eval scrut-ast env) clauses env)))

;; Auto-curry: (:fun ("x" "y" "z") body) → (fn (x) (fn (y) (fn (z) body))).
;; A zero-param lambda evaluates the body immediately on first call —
;; OCaml does not have nullary functions; `()`-taking functions still
;; receive the unit argument via a one-param lambda.
(define ocaml-make-curried
  (fn (params body env)
    (cond
      ((= (len params) 0)
        (ocaml-eval body env))
      ((= (len params) 1)
        (fn (arg)
          (ocaml-eval body
            (ocaml-env-extend env (nth params 0) arg))))
      (else
        (fn (arg)
          (ocaml-make-curried
            (rest params)
            body
            (ocaml-env-extend env (nth params 0) arg)))))))

(define ocaml-eval-op
  (fn (op lhs rhs)
    (cond
      ((= op "+")    (+ lhs rhs))
      ((= op "-")    (- lhs rhs))
      ((= op "*")    (* lhs rhs))
      ((= op "/")
        ;; OCaml's `/` is integer division on ints, float on floats.
        ;; Pick floor on ints.
        (cond
          ((and (number? lhs) (number? rhs)
                (= (round lhs) lhs) (= (round rhs) rhs))
            (let ((q (/ lhs rhs)))
              (if (>= q 0) (floor q) (ceil q))))
          (else (/ lhs rhs))))
      ((= op "+.")   (+ lhs rhs))
      ((= op "-.")   (- lhs rhs))
      ((= op "*.")   (* lhs rhs))
      ((= op "/.")   (/ lhs rhs))
      ((= op "mod")  (mod lhs rhs))
      ((= op "%")    (mod lhs rhs))
      ((= op "**")   (pow lhs rhs))
      ((= op "^")    (str lhs rhs))
      ((= op "@")    (concat lhs rhs))
      ((= op "::")   (cons lhs rhs))
      ((= op "=")    (= lhs rhs))
      ((= op "<>")   (not (= lhs rhs)))
      ((= op "==")   (= lhs rhs))
      ((= op "!=")   (not (= lhs rhs)))
      ((= op "<")    (< lhs rhs))
      ((= op ">")    (> lhs rhs))
      ((= op "<=")   (<= lhs rhs))
      ((= op ">=")   (>= lhs rhs))
      ((= op "&&")   (and lhs rhs))
      ((= op "||")   (or lhs rhs))
      ;; Bitwise ops — implemented via arithmetic since SX doesn't
      ;; expose host bitwise primitives.
      ((= op "land")
        (let ((r 0) (f 1) (a lhs) (b rhs))
          (begin
            (define loop
              (fn ()
                (when (and (> a 0) (> b 0))
                  (begin
                    (when (and (= (mod a 2) 1) (= (mod b 2) 1))
                      (set! r (+ r f)))
                    (set! a (floor (/ a 2)))
                    (set! b (floor (/ b 2)))
                    (set! f (* f 2))
                    (loop)))))
            (loop)
            r)))
      ((= op "lor")
        (let ((r 0) (f 1) (a lhs) (b rhs))
          (begin
            (define loop
              (fn ()
                (when (or (> a 0) (> b 0))
                  (begin
                    (when (or (= (mod a 2) 1) (= (mod b 2) 1))
                      (set! r (+ r f)))
                    (set! a (floor (/ a 2)))
                    (set! b (floor (/ b 2)))
                    (set! f (* f 2))
                    (loop)))))
            (loop)
            r)))
      ((= op "lxor")
        (let ((r 0) (f 1) (a lhs) (b rhs))
          (begin
            (define loop
              (fn ()
                (when (or (> a 0) (> b 0))
                  (begin
                    (when (not (= (mod a 2) (mod b 2)))
                      (set! r (+ r f)))
                    (set! a (floor (/ a 2)))
                    (set! b (floor (/ b 2)))
                    (set! f (* f 2))
                    (loop)))))
            (loop)
            r)))
      ((= op "lsl")
        (let ((r lhs) (k rhs))
          (begin
            (define loop
              (fn ()
                (when (> k 0) (begin (set! r (* r 2)) (set! k (- k 1)) (loop)))))
            (loop)
            r)))
      ((= op "lsr")
        (let ((r lhs) (k rhs))
          (begin
            (define loop
              (fn ()
                (when (> k 0)
                  (begin (set! r (floor (/ r 2))) (set! k (- k 1)) (loop)))))
            (loop)
            r)))
      ((= op "asr")
        (let ((r lhs) (k rhs))
          (begin
            (define loop
              (fn ()
                (when (> k 0)
                  (begin (set! r (floor (/ r 2))) (set! k (- k 1)) (loop)))))
            (loop)
            r)))
      ((= op "or")   (or lhs rhs))
      ((= op "|>")   (rhs lhs))
      (else (error (str "ocaml-eval: unknown operator " op))))))

(set! ocaml-eval
  (fn (ast env)
    (let ((tag (ocaml-tag-of ast)))
      (cond
        ((= tag "int")    (nth ast 1))
        ((= tag "float")  (nth ast 1))
        ((= tag "string") (nth ast 1))
        ((= tag "char")   (nth ast 1))
        ((= tag "bool")   (nth ast 1))
        ((= tag "unit")   nil)
        ((= tag "var")
          (let ((name (nth ast 1)))
            (cond
              ((ocaml-env-has? env name) (ocaml-env-lookup env name))
              (else (error (str "ocaml-eval: unbound variable " name))))))
        ((= tag "neg") (- 0 (ocaml-eval (nth ast 1) env)))
        ((= tag "not") (not (ocaml-eval (nth ast 1) env)))
        ((= tag "assert")
          (let ((v (ocaml-eval (nth ast 1) env)))
            (cond
              ((= v false) (error "Assert_failure"))
              (else nil))))
        ((= tag "lazy")
          ;; (:lazy EXPR) — create a one-element cell containing
          ;; ("Thunk" EXPR env); _lazy_force evaluates and caches.
          (let ((expr (nth ast 1)))
            (list (list "Thunk" expr env))))
        ((= tag "deref")
          (let ((cell (ocaml-eval (nth ast 1) env)))
            (nth cell 0)))
        ((= tag "op")
          (let ((op (nth ast 1)))
            (cond
              ;; := mutates the lhs cell — short-circuit before generic
              ;; eval-op so we still evaluate lhs (to obtain the cell).
              ((= op ":=")
                (let ((cell (ocaml-eval (nth ast 2) env))
                      (new-val (ocaml-eval (nth ast 3) env)))
                  (begin (set-nth! cell 0 new-val) nil)))
              ;; <- mutates a record field. The lhs must be a (:field ...).
              ((= op "<-")
                (let ((lhs-ast (nth ast 2)) (new-val (ocaml-eval (nth ast 3) env)))
                  (cond
                    ((= (ocaml-tag-of lhs-ast) "field")
                      (let ((target (ocaml-eval (nth lhs-ast 1) env))
                            (fname (nth lhs-ast 2)))
                        (begin (dict-set! target fname new-val) nil)))
                    ((= (ocaml-tag-of lhs-ast) "array-get")
                      ;; (:array-get ARR I) <- v : rewrite the underlying
                      ;; list in the ref cell with one cell changed.
                      (let ((arr (ocaml-eval (nth lhs-ast 1) env))
                            (i (ocaml-eval (nth lhs-ast 2) env)))
                        (begin
                          (define replace
                            (fn (lst k)
                              (cond
                                ((= lst (list)) (list))
                                ((= k 0) (cons new-val (rest lst)))
                                (else
                                  (cons (first lst)
                                        (replace (rest lst) (- k 1)))))))
                          (set-nth! arr 0 (replace (nth arr 0) i))
                          nil)))
                    (else
                      (error
                        (str "ocaml-eval: <- expects a field-access lhs, got "
                             (ocaml-tag-of lhs-ast)))))))
              (else
                (ocaml-eval-op op
                  (ocaml-eval (nth ast 2) env)
                  (ocaml-eval (nth ast 3) env))))))
        ((= tag "if")
          (if (ocaml-eval (nth ast 1) env)
              (ocaml-eval (nth ast 2) env)
              (ocaml-eval (nth ast 3) env)))
        ((= tag "seq")
          (let ((items (rest ast)) (last nil))
            (begin
              (define loop
                (fn (xs)
                  (when (not (= xs (list)))
                    (begin
                      (set! last (ocaml-eval (first xs) env))
                      (loop (rest xs))))))
              (loop items)
              last)))
        ((= tag "tuple")
          (cons :tuple
            (map (fn (e) (ocaml-eval e env)) (rest ast))))
        ((= tag "list")
          (map (fn (e) (ocaml-eval e env)) (rest ast)))
        ((= tag "fun")
          (ocaml-make-curried (nth ast 1) (nth ast 2) env))
        ((= tag "con")
          ;; Standalone ctor — produces a nullary tagged value.
          (list (nth ast 1)))
        ((= tag "app")
          (let ((fn-ast (nth ast 1)))
            (cond
              ;; Constructor application: build a tagged value, flattening
              ;; a tuple arg into multiple ctor args (so `Pair (a, b)`
              ;; becomes ("Pair" va vb) — matches the parser's pattern
              ;; flattening).
              ((= (ocaml-tag-of fn-ast) "con")
                (let ((name (nth fn-ast 1))
                      (arg-val (ocaml-eval (nth ast 2) env)))
                  (cond
                    ((and (list? arg-val) (not (empty? arg-val))
                          (= (first arg-val) "tuple"))
                      (cons name (rest arg-val)))
                    (else (list name arg-val)))))
              (else
                (let ((fn-val (ocaml-eval fn-ast env))
                      (arg-val (ocaml-eval (nth ast 2) env)))
                  (fn-val arg-val))))))
        ((= tag "match")
          (ocaml-match-eval (nth ast 1) (nth ast 2) env))
        ((= tag "function")
          ;; `function | pat -> body | …` — produces a unary closure that
          ;; matches its argument against the clauses.
          (let ((clauses (nth ast 1)) (captured env))
            (fn (arg) (ocaml-match-clauses arg clauses captured))))
        ((= tag "record")
          (let ((fields (rest ast)) (result {}))
            (begin
              (define loop
                (fn (xs)
                  (when (not (= xs (list)))
                    (let ((kv (first xs)))
                      (let ((k (first kv)) (v (ocaml-eval (nth kv 1) env)))
                        (begin
                          (set! result (merge result (dict k v)))
                          (loop (rest xs))))))))
              (loop fields)
              result)))
        ((= tag "record-update")
          (let ((base-ast (nth ast 1)) (fields (rest (rest ast))))
            (let ((base (ocaml-eval base-ast env)))
              (cond
                ((dict? base)
                  (let ((result base))
                    (begin
                      (define loop
                        (fn (xs)
                          (when (not (= xs (list)))
                            (let ((kv (first xs)))
                              (let ((k (first kv)) (v (ocaml-eval (nth kv 1) env)))
                                (begin
                                  (set! result (merge result (dict k v)))
                                  (loop (rest xs))))))))
                      (loop fields)
                      result)))
                (else (error (str "ocaml-eval: with-update on non-record: " base)))))))
        ((= tag "field")
          ;; `e.name` — evaluate e, expect a dict (record/module), get name.
          ;; Special case: `(:field (:con "M") "x")` looks up M as a module
          ;; binding rather than evaluating it as a nullary ctor.
          (let ((target-ast (nth ast 1)) (fname (nth ast 2)))
            (let ((target
                    (cond
                      ((= (ocaml-tag-of target-ast) "con")
                        (cond
                          ((ocaml-env-has? env (nth target-ast 1))
                            (ocaml-env-lookup env (nth target-ast 1)))
                          (else (list (nth target-ast 1)))))
                      (else (ocaml-eval target-ast env)))))
              (cond
                ((dict? target) (get target fname))
                (else (error
                  (str "ocaml-eval: not a record/module on .field: " target)))))))
        ((= tag "string-get")
          ;; (:string-get S I) — evaluate s.[i] as a char access.
          (let ((s (ocaml-eval (nth ast 1) env))
                (i (ocaml-eval (nth ast 2) env)))
            (nth s i)))
        ((= tag "array-get")
          ;; (:array-get ARR I) — Array.get on a ref-of-list.
          (let ((arr (ocaml-eval (nth ast 1) env))
                (i (ocaml-eval (nth ast 2) env)))
            (nth (nth arr 0) i)))
        ((= tag "for")
          ;; (:for NAME LO HI DIR BODY) — DIR is "ascend" or "descend".
          (let ((name (nth ast 1))
                (lo (ocaml-eval (nth ast 2) env))
                (hi (ocaml-eval (nth ast 3) env))
                (dir (nth ast 4))
                (body (nth ast 5)))
            (begin
              (cond
                ((= dir "ascend")
                  (let ((i lo))
                    (begin
                      (define loop
                        (fn ()
                          (when (<= i hi)
                            (begin
                              (ocaml-eval body
                                (ocaml-env-extend env name i))
                              (set! i (+ i 1))
                              (loop)))))
                      (loop))))
                ((= dir "descend")
                  (let ((i lo))
                    (begin
                      (define loop
                        (fn ()
                          (when (>= i hi)
                            (begin
                              (ocaml-eval body
                                (ocaml-env-extend env name i))
                              (set! i (- i 1))
                              (loop)))))
                      (loop)))))
              nil)))
        ((= tag "try")
          ;; (:try EXPR CLAUSES) — evaluate EXPR; if it raises, match
          ;; the raised value against CLAUSES (case + case-when).
          ;; Re-raise on no-match.
          (let ((expr (nth ast 1)) (clauses (nth ast 2)) (env-cap env))
            (guard (e
                    (else
                      (begin
                        (define try-clauses
                          (fn (cs)
                            (cond
                              ((empty? cs) (raise e))
                              (else
                                (let ((clause (first cs)))
                                  (let ((ctag (nth clause 0)))
                                    (cond
                                      ((= ctag "case")
                                        (let ((pat (nth clause 1))
                                              (body (nth clause 2)))
                                          (let ((env2 (ocaml-match-pat pat e env-cap)))
                                            (cond
                                              ((= env2 ocaml-match-fail)
                                                (try-clauses (rest cs)))
                                              (else (ocaml-eval body env2))))))
                                      ((= ctag "case-when")
                                        (let ((pat (nth clause 1))
                                              (g (nth clause 2))
                                              (body (nth clause 3)))
                                          (let ((env2 (ocaml-match-pat pat e env-cap)))
                                            (cond
                                              ((= env2 ocaml-match-fail) (try-clauses (rest cs)))
                                              ((not (ocaml-eval g env2)) (try-clauses (rest cs)))
                                              (else (ocaml-eval body env2))))))
                                      (else (raise e)))))))))
                        (try-clauses clauses))))
              (ocaml-eval expr env-cap))))
        ((= tag "while")
          (let ((cond-ast (nth ast 1)) (body (nth ast 2)))
            (begin
              (define loop
                (fn ()
                  (when (ocaml-eval cond-ast env)
                    (begin
                      (ocaml-eval body env)
                      (loop)))))
              (loop)
              nil)))
        ((= tag "let")
          (let ((name (nth ast 1)) (params (nth ast 2))
                (rhs (nth ast 3)) (body (nth ast 4)))
            (let ((rhs-val
                    (if (= (len params) 0)
                        (ocaml-eval rhs env)
                        (ocaml-make-curried params rhs env))))
              (ocaml-eval body (ocaml-env-extend env name rhs-val)))))
        ((= tag "let-mut")
          ;; (:let-mut BINDINGS BODY) — non-rec multi-binding let-in.
          ;; Each rhs evaluated in the parent env, then names bound
          ;; sequentially before evaluating BODY.
          (let ((bindings (nth ast 1)) (body (nth ast 2)) (env-cur env))
            (begin
              (define one
                (fn (b)
                  (let ((nm (nth b 0)) (ps (nth b 1)) (rh (nth b 2)))
                    (let ((v (if (= (len ps) 0)
                                 (ocaml-eval rh env-cur)
                                 (ocaml-make-curried ps rh env-cur))))
                      (set! env-cur (ocaml-env-extend env-cur nm v))))))
              (define loop
                (fn (xs)
                  (when (not (= xs (list)))
                    (begin (one (first xs)) (loop (rest xs))))))
              (loop bindings)
              (ocaml-eval body env-cur))))
        ((= tag "let-rec-mut")
          ;; (:let-rec-mut BINDINGS BODY) — mutually-recursive let-in.
          (let ((bindings (nth ast 1)) (body (nth ast 2))
                (env2 env) (cells (list)))
            (begin
              (define alloc
                (fn (xs)
                  (when (not (= xs (list)))
                    (let ((b (first xs)))
                      (let ((c (list nil)) (nm (nth b 0)))
                        (begin
                          (append! cells c)
                          (set! env2 (ocaml-env-extend env2 nm
                                       (fn (a) ((nth c 0) a))))
                          (alloc (rest xs))))))))
              (alloc bindings)
              (let ((idx 0))
                (begin
                  (define fill
                    (fn (xs)
                      (when (not (= xs (list)))
                        (let ((b (first xs)))
                          (let ((nm (nth b 0)) (ps (nth b 1)) (rh (nth b 2)))
                            (let ((v (if (= (len ps) 0)
                                         (ocaml-eval rh env2)
                                         (ocaml-make-curried ps rh env2))))
                              (begin
                                (set-nth! (nth cells idx) 0 v)
                                (set! idx (+ idx 1))
                                (fill (rest xs)))))))))
                  (fill bindings)
                  (ocaml-eval body env2))))))
        ((= tag "let-open")
          ;; `let open M in body` — extend env with M's bindings, eval body.
          (let ((path-expr (nth ast 1)) (body (nth ast 2)))
            (let ((mod-val (ocaml-resolve-module-path path-expr env)))
              (cond
                ((dict? mod-val)
                  (ocaml-eval body (ocaml-env-merge-dict env mod-val)))
                (else (error (str "ocaml-eval: let open on non-module: " mod-val)))))))
        ((= tag "let-rec")
          ;; Tie the knot via a mutable cell when rhs is function-typed.
          ;; The placeholder closure dereferences the cell on each call.
          (let ((name (nth ast 1)) (params (nth ast 2))
                (rhs (nth ast 3)) (body (nth ast 4)))
            (let ((rhs-fn?
                    (or (> (len params) 0)
                        (= (ocaml-tag-of rhs) "fun")
                        (= (ocaml-tag-of rhs) "function"))))
              (cond
                (rhs-fn?
                  (let ((cell (list nil)))
                    (let ((env2 (ocaml-env-extend env name
                                  (fn (arg) ((nth cell 0) arg)))))
                      (let ((rhs-val
                              (if (= (len params) 0)
                                  (ocaml-eval rhs env2)
                                  (ocaml-make-curried params rhs env2))))
                        (begin
                          (set-nth! cell 0 rhs-val)
                          (ocaml-eval body env2))))))
                (else
                  (let ((rhs-val (ocaml-eval rhs env)))
                    (ocaml-eval body
                      (ocaml-env-extend env name rhs-val))))))))
        (else (error
          (str "ocaml-eval: unknown AST tag " tag)))))))

;; ocaml-make-functor — build a curried host-SX closure that accepts
;; argument modules (one per param) and returns the resulting module dict
;; produced by evaluating the functor's body.
(define ocaml-make-functor
  (fn (params decls captured-env)
    (cond
      ((= (len params) 1)
        (fn (arg-mod)
          (ocaml-eval-module decls
            (ocaml-env-extend captured-env (first params) arg-mod))))
      (else
        (fn (arg-mod)
          (ocaml-make-functor (rest params) decls
            (ocaml-env-extend captured-env (first params) arg-mod)))))))

;; ocaml-eval-module — evaluate a list of decls in a fresh sub-env layered
;; on top of the parent. Returns a dict mapping each declared name to its
;; value. Used by `module M = struct DECLS end`.
(define ocaml-eval-module
  (fn (decls parent-env)
    (let ((env parent-env) (result {}))
      (begin
        (define run-decl
          (fn (decl)
            (let ((tag (ocaml-tag-of decl)))
              (cond
                ((= tag "def")
                  (let ((name (nth decl 1)) (params (nth decl 2)) (rhs (nth decl 3)))
                    (let ((v (if (= (len params) 0)
                                 (ocaml-eval rhs env)
                                 (ocaml-make-curried params rhs env))))
                      (begin
                        (set! env (ocaml-env-extend env name v))
                        (set! result (merge result (dict name v)))))))
                ((= tag "def-rec")
                  (let ((name (nth decl 1)) (params (nth decl 2)) (rhs (nth decl 3)))
                    (let ((rhs-fn?
                            (or (> (len params) 0)
                                (= (ocaml-tag-of rhs) "fun")
                                (= (ocaml-tag-of rhs) "function"))))
                      (cond
                        (rhs-fn?
                          (let ((cell (list nil)))
                            (let ((env2 (ocaml-env-extend env name
                                          (fn (arg) ((nth cell 0) arg)))))
                              (let ((v (if (= (len params) 0)
                                           (ocaml-eval rhs env2)
                                           (ocaml-make-curried params rhs env2))))
                                (begin
                                  (set-nth! cell 0 v)
                                  (set! env env2)
                                  (set! result (merge result (dict name v))))))))
                        (else
                          (let ((v (ocaml-eval rhs env)))
                            (begin
                              (set! env (ocaml-env-extend env name v))
                              (set! result (merge result (dict name v))))))))))
                ((= tag "def-mut")
                  ;; let x = ... and y = ... — sequential top-level binds.
                  (let ((bs (nth decl 1)))
                    (begin
                      (define run-one
                        (fn (b)
                          (let ((nm (nth b 0)) (ps (nth b 1)) (rh (nth b 2)))
                            (let ((v (if (= (len ps) 0)
                                         (ocaml-eval rh env)
                                         (ocaml-make-curried ps rh env))))
                              (begin
                                (set! env (ocaml-env-extend env nm v))
                                (set! result (merge result (dict nm v))))))))
                      (define loop
                        (fn (xs)
                          (when (not (= xs (list)))
                            (begin (run-one (first xs)) (loop (rest xs))))))
                      (loop bs))))
                ((= tag "def-rec-mut")
                  ;; let rec f = ... and g = ... — mutual recursion.
                  (let ((bs (nth decl 1)) (cells (list)))
                    (begin
                      (define alloc
                        (fn (xs)
                          (when (not (= xs (list)))
                            (let ((b (first xs)))
                              (let ((c (list nil)) (nm (nth b 0)))
                                (begin
                                  (append! cells c)
                                  (set! env (ocaml-env-extend env nm
                                              (fn (a) ((nth c 0) a))))
                                  (alloc (rest xs))))))))
                      (alloc bs)
                      (let ((idx 0))
                        (begin
                          (define fill
                            (fn (xs)
                              (when (not (= xs (list)))
                                (let ((b (first xs)))
                                  (let ((nm (nth b 0)) (ps (nth b 1)) (rh (nth b 2)))
                                    (let ((v (if (= (len ps) 0)
                                                 (ocaml-eval rh env)
                                                 (ocaml-make-curried ps rh env))))
                                      (begin
                                        (set-nth! (nth cells idx) 0 v)
                                        (set! result (merge result (dict nm v)))
                                        (set! idx (+ idx 1))
                                        (fill (rest xs)))))))))
                          (fill bs))))))
                ((= tag "expr")
                  (ocaml-eval (nth decl 1) env))
                ((= tag "module-def")
                  (let ((mname (nth decl 1)) (mdecls (nth decl 2)))
                    (let ((mod-val (ocaml-eval-module mdecls env)))
                      (begin
                        (set! env (ocaml-env-extend env mname mod-val))
                        (set! result (merge result (dict mname mod-val)))))))
                ((= tag "functor-def")
                  (let ((mname (nth decl 1))
                        (mparams (nth decl 2))
                        (mdecls (nth decl 3)))
                    (let ((fn-val (ocaml-make-functor mparams mdecls env)))
                      (begin
                        (set! env (ocaml-env-extend env mname fn-val))
                        (set! result (merge result (dict mname fn-val)))))))
                ((= tag "module-alias")
                  (let ((mname (nth decl 1)) (body-src (nth decl 2)))
                    (let ((body-expr (ocaml-parse body-src)))
                      (let ((mod-val (ocaml-resolve-module-path body-expr env)))
                        (begin
                          (set! env (ocaml-env-extend env mname mod-val))
                          (set! result (merge result (dict mname mod-val))))))))
                ((= tag "type-def") nil)
                ((= tag "type-def-record") nil)
                ((= tag "type-alias") nil)
                ((= tag "exception-def") nil)
                ((= tag "module-type-def") nil)
                ((= tag "open")
                  (let ((mod-val (ocaml-resolve-module-path (nth decl 1) env)))
                    (cond
                      ((dict? mod-val)
                        (set! env (ocaml-env-merge-dict env mod-val)))
                      (else (error
                        (str "ocaml-eval: open on non-module: " mod-val))))))
                ((= tag "include")
                  ;; `include M` brings M's bindings into scope AND into
                  ;; the surrounding module's exports.
                  (let ((mod-val (ocaml-resolve-module-path (nth decl 1) env)))
                    (cond
                      ((dict? mod-val)
                        (begin
                          (set! env (ocaml-env-merge-dict env mod-val))
                          (set! result (merge result mod-val))))
                      (else (error
                        (str "ocaml-eval: include on non-module: " mod-val))))))
                (else (error (str "ocaml-eval-module: bad decl " tag)))))))
        (define loop
          (fn (xs)
            (when (not (= xs (list)))
              (begin (run-decl (first xs)) (loop (rest xs))))))
        (loop decls)
        result))))

;; ocaml-run — convenience wrapper: parse + eval. Layers the stdlib env
;; (List, Option, Result) underneath the empty env so user code can use
;; `List.map` etc. without explicit setup.
;; Variable guarded so eval.sx is loadable without runtime.sx. runtime.sx
;; sets ocaml-stdlib-env once loaded; before that, fall back to the empty
;; env so the existing tests continue to work without stdlib.
(define ocaml-stdlib-env nil)
(define ocaml-base-env
  (fn ()
    (cond
      ((not (= ocaml-stdlib-env nil)) ocaml-stdlib-env)
      (else (ocaml-empty-env)))))

(define ocaml-run
  (fn (src)
    (ocaml-eval (ocaml-parse src) (ocaml-base-env))))

;; ocaml-run-program — evaluate a program (sequence of decls + bare exprs).
;; Threads an env through decls; returns the value of the last form.
(define ocaml-run-program
  (fn (src)
    (let ((prog (ocaml-parse-program src)) (env (ocaml-base-env)) (last nil))
      (begin
        (define run-decl
          (fn (decl)
            (let ((tag (ocaml-tag-of decl)))
              (cond
                ((= tag "def")
                  (let ((name (nth decl 1)) (params (nth decl 2)) (rhs (nth decl 3)))
                    (let ((v (if (= (len params) 0)
                                 (ocaml-eval rhs env)
                                 (ocaml-make-curried params rhs env))))
                      (begin
                        (set! env (ocaml-env-extend env name v))
                        (set! last v)))))
                ((= tag "def-rec")
                  (let ((name (nth decl 1)) (params (nth decl 2)) (rhs (nth decl 3)))
                    (let ((rhs-fn?
                            (or (> (len params) 0)
                                (= (ocaml-tag-of rhs) "fun")
                                (= (ocaml-tag-of rhs) "function"))))
                      (cond
                        (rhs-fn?
                          (let ((cell (list nil)))
                            (let ((env2 (ocaml-env-extend env name
                                          (fn (arg) ((nth cell 0) arg)))))
                              (let ((v
                                      (if (= (len params) 0)
                                          (ocaml-eval rhs env2)
                                          (ocaml-make-curried params rhs env2))))
                                (begin
                                  (set-nth! cell 0 v)
                                  (set! env env2)
                                  (set! last v))))))
                        (else
                          (let ((v (ocaml-eval rhs env)))
                            (begin
                              (set! env (ocaml-env-extend env name v))
                              (set! last v))))))))
                ((= tag "def-mut")
                  ;; let x = ... and y = ... — non-recursive; each rhs is
                  ;; evaluated in the parent env, then all names bind in
                  ;; sequence.
                  (let ((bs (nth decl 1)))
                    (begin
                      (define run-one
                        (fn (b)
                          (let ((nm (nth b 0)) (ps (nth b 1)) (rh (nth b 2)))
                            (let ((v (if (= (len ps) 0)
                                         (ocaml-eval rh env)
                                         (ocaml-make-curried ps rh env))))
                              (begin
                                (set! env (ocaml-env-extend env nm v))
                                (set! last v))))))
                      (define loop
                        (fn (xs)
                          (when (not (= xs (list)))
                            (begin (run-one (first xs)) (loop (rest xs))))))
                      (loop bs))))
                ((= tag "def-rec-mut")
                  ;; let rec f = ... and g = ... — mutually recursive;
                  ;; bind all names with placeholder cells first, then
                  ;; evaluate each rhs in the joint env, finally fill cells.
                  (let ((bs (nth decl 1)) (cells (list)) (env2 env))
                    (begin
                      (define alloc
                        (fn (xs)
                          (when (not (= xs (list)))
                            (let ((b (first xs)))
                              (let ((c (list nil)) (nm (nth b 0)))
                                (begin
                                  (append! cells c)
                                  (set! env2 (ocaml-env-extend env2 nm
                                               (fn (a) ((nth c 0) a))))
                                  (alloc (rest xs))))))))
                      (alloc bs)
                      (let ((idx 0))
                        (begin
                          (define fill
                            (fn (xs)
                              (when (not (= xs (list)))
                                (let ((b (first xs)))
                                  (let ((nm (nth b 0)) (ps (nth b 1)) (rh (nth b 2)))
                                    (let ((v (if (= (len ps) 0)
                                                 (ocaml-eval rh env2)
                                                 (ocaml-make-curried ps rh env2))))
                                      (begin
                                        (set-nth! (nth cells idx) 0 v)
                                        (set! idx (+ idx 1))
                                        (set! last v)
                                        (fill (rest xs)))))))))
                          (fill bs)
                          (set! env env2))))))
                ((= tag "expr")
                  (set! last (ocaml-eval (nth decl 1) env)))
                ((= tag "module-def")
                  ;; module M = struct DECLS end — evaluate the inner
                  ;; decls in a fresh sub-env layered on the current
                  ;; one, then collect the new bindings into a dict that
                  ;; we bind under M.
                  (let ((mname (nth decl 1)) (mdecls (nth decl 2)))
                    (let ((mod-val (ocaml-eval-module mdecls env)))
                      (begin
                        (set! env (ocaml-env-extend env mname mod-val))
                        (set! last mod-val)))))
                ((= tag "functor-def")
                  ;; module F (M1) (M2) ... = struct DECLS end — bind F
                  ;; to a curried function from module dicts to a module
                  ;; dict.
                  (let ((mname (nth decl 1))
                        (mparams (nth decl 2))
                        (mdecls (nth decl 3)))
                    (let ((functor-val
                            (ocaml-make-functor mparams mdecls env)))
                      (begin
                        (set! env (ocaml-env-extend env mname functor-val))
                        (set! last functor-val)))))
                ((= tag "module-alias")
                  ;; module N = M  /  module N = F(A)  /  module N = M.Sub
                  (let ((mname (nth decl 1)) (body-src (nth decl 2)))
                    (let ((body-expr (ocaml-parse body-src)))
                      (let ((mod-val (ocaml-resolve-module-path body-expr env)))
                        (begin
                          (set! env (ocaml-env-extend env mname mod-val))
                          (set! last mod-val))))))
                ((= tag "type-def")
                  ;; type t = ... — purely declarative at runtime; ctors
                  ;; are dispatched by tag at eval/match time. Phase 5
                  ;; HM extensions will register ctor types here.
                  nil)
                ((= tag "exception-def")
                  ;; exception E [of T] — purely declarative; raise+match
                  ;; already work on tagged ctor values.
                  nil)
                ((= tag "type-def-record")
                  ;; type r = { x : T; y : T } — runtime no-op; records
                  ;; are already dynamic dicts.
                  nil)
                ((= tag "type-alias")
                  ;; type t = SomeType — runtime no-op (no nominal types).
                  nil)
                ((= tag "module-type-def")
                  ;; module type S = sig … end — no-op at runtime.
                  nil)
                ((or (= tag "open") (= tag "include"))
                  ;; open M / include M — bring M's bindings into scope.
                  (let ((mod-val (ocaml-resolve-module-path (nth decl 1) env)))
                    (cond
                      ((dict? mod-val)
                        (begin
                          (set! env (ocaml-env-merge-dict env mod-val))
                          (set! last mod-val)))
                      (else (error (str "ocaml-eval: open/include on non-module: " mod-val))))))
                (else (error (str "ocaml-run-program: bad decl " tag)))))))
        (define loop
          (fn (xs)
            (when (not (= xs (list)))
              (begin (run-decl (first xs)) (loop (rest xs))))))
        (loop (rest prog))
        last))))
