giles
4dca583ee3
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 52s
ocaml-eval walks the AST and yields SX values. ocaml-run / ocaml-run-program wrap parse + eval. Coverage: atoms, vars, app (curried), 22 binary ops, prefix - and not, if/seq/tuple/list, fun (auto-curried via host SX lambdas), let, let-rec (mutable-cell knot for recursive functions). Initial env: not/succ/pred/abs/max/min/fst/snd/ignore. Tests: arithmetic, comparison, string concat, closures, fact 5 / fib 10 / sum 100, top-level decls, |> pipe.
245 lines
9.3 KiB
Plaintext
245 lines
9.3 KiB
Plaintext
;; 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))))
|