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

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

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

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

;; 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 "op")
          (ocaml-eval-op
            (nth ast 1)
            (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 "app")
          (let ((fn-val (ocaml-eval (nth ast 1) env))
                (arg-val (ocaml-eval (nth ast 2) env)))
            (fn-val arg-val)))
        ((= 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")
          ;; For function bindings: tie the knot via a mutable cell. The
          ;; placeholder closure that's bound first dereferences the cell
          ;; on each call, so the function can call itself once the cell
          ;; is set to the real closure.
          (let ((name (nth ast 1)) (params (nth ast 2))
                (rhs (nth ast 3)) (body (nth ast 4)))
            (cond
              ((= (len params) 0)
                ;; Non-functional let-rec — OCaml only allows this when the
                ;; rhs is "syntactically a function or constructor". For the
                ;; common case of a value, evaluate non-recursively.
                (let ((rhs-val (ocaml-eval rhs env)))
                  (ocaml-eval body (ocaml-env-extend env name rhs-val))))
              (else
                ;; Use a one-element list as a mutable cell to tie the
                ;; recursive knot. The placeholder closure dereferences
                ;; the cell on each call.
                (let ((cell (list nil)))
                  (let ((env2 (ocaml-env-extend env name
                                (fn (arg) ((nth cell 0) arg)))))
                    (let ((rhs-val (ocaml-make-curried params rhs env2)))
                      (begin
                        (set-nth! cell 0 rhs-val)
                        (ocaml-eval body env2)))))))))
        (else (error
          (str "ocaml-eval: unknown AST tag " tag)))))))

;; ocaml-run — convenience wrapper: parse + eval.
(define ocaml-run
  (fn (src)
    (ocaml-eval (ocaml-parse src) (ocaml-empty-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-empty-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)))
                    (cond
                      ((= (len params) 0)
                        (let ((v (ocaml-eval rhs env)))
                          (begin
                            (set! env (ocaml-env-extend env name v))
                            (set! last v))))
                      (else
                        (let ((cell (list nil)))
                          (let ((env2 (ocaml-env-extend env name
                                        (fn (arg) ((nth cell 0) arg)))))
                            (let ((v (ocaml-make-curried params rhs env2)))
                              (begin
                                (set-nth! cell 0 v)
                                (set! env env2)
                                (set! last v)))))))))
                ((= tag "expr")
                  (set! last (ocaml-eval (nth decl 1) env)))
                (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))))