;; 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 "_int_of_string" (fn (s) (parse-number s)))
      (list "_string_of_int" (fn (i) (str i)))
      (list "_string_of_float" (fn (f) (str f)))
      (list "_char_code" (fn (c) (char-code c)))
      (list "_char_chr"  (fn (n) (char-from-code n)))
      ;; Print: prints to host stdout via println.
      (list "print_string"  (fn (s) (begin (print s) nil)))
      (list "print_endline" (fn (s) (begin (println s) nil)))
      (list "print_int"     (fn (i) (begin (print (str i)) nil))))))

(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 "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 "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 ((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))))))))))
      (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 "/")    (/ 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))
      ((= 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 "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)))
              (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 "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 "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. 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 ((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))))))))))
                        (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-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 "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 "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))))))
                ((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))))