From 4dca583ee36069dc40d08f70085f548745ec4f4e Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 07:57:20 +0000 Subject: [PATCH] ocaml: phase 2 evaluator slice (+42 tests, 165 total) 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. --- lib/ocaml/eval.sx | 244 +++++++++++++++++++++++++++++++++++++++++++ lib/ocaml/test.sh | 173 ++++++++++++++++++++++++++++++ plans/ocaml-on-sx.md | 26 +++-- 3 files changed, 436 insertions(+), 7 deletions(-) create mode 100644 lib/ocaml/eval.sx diff --git a/lib/ocaml/eval.sx b/lib/ocaml/eval.sx new file mode 100644 index 00000000..8fcb3d16 --- /dev/null +++ b/lib/ocaml/eval.sx @@ -0,0 +1,244 @@ +;; 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)))) diff --git a/lib/ocaml/test.sh b/lib/ocaml/test.sh index b6e0821d..83dc82a6 100755 --- a/lib/ocaml/test.sh +++ b/lib/ocaml/test.sh @@ -32,6 +32,7 @@ cat > "$TMPFILE" << 'EPOCHS' (load "lib/guest/pratt.sx") (load "lib/ocaml/tokenizer.sx") (load "lib/ocaml/parser.sx") +(load "lib/ocaml/eval.sx") (load "lib/ocaml/tests/tokenize.sx") ;; ── empty / eof ──────────────────────────────────────────────── @@ -322,6 +323,113 @@ cat > "$TMPFILE" << 'EPOCHS' (epoch 329) (eval "(ocaml-parse \"match x with | _ -> a; b\")") +;; ── Phase 2: evaluator ───────────────────────────────────────── +;; Atoms +(epoch 400) +(eval "(ocaml-run \"42\")") +(epoch 401) +(eval "(ocaml-run \"3.14\")") +(epoch 402) +(eval "(ocaml-run \"true\")") +(epoch 403) +(eval "(ocaml-run \"false\")") +(epoch 404) +(eval "(ocaml-run \"\\\"hi\\\"\")") + +;; Arithmetic +(epoch 410) +(eval "(ocaml-run \"1 + 2\")") +(epoch 411) +(eval "(ocaml-run \"10 - 3\")") +(epoch 412) +(eval "(ocaml-run \"4 * 5\")") +(epoch 413) +(eval "(ocaml-run \"20 / 4\")") +(epoch 414) +(eval "(ocaml-run \"10 mod 3\")") +(epoch 415) +(eval "(ocaml-run \"2 ** 10\")") +(epoch 416) +(eval "(ocaml-run \"(1 + 2) * 3\")") +(epoch 417) +(eval "(ocaml-run \"1 + 2 * 3\")") +(epoch 418) +(eval "(ocaml-run \"-5 + 10\")") + +;; Comparison & boolean +(epoch 420) +(eval "(ocaml-run \"1 < 2\")") +(epoch 421) +(eval "(ocaml-run \"3 > 2\")") +(epoch 422) +(eval "(ocaml-run \"2 = 2\")") +(epoch 423) +(eval "(ocaml-run \"1 <> 2\")") +(epoch 424) +(eval "(ocaml-run \"true && false\")") +(epoch 425) +(eval "(ocaml-run \"true || false\")") +(epoch 426) +(eval "(ocaml-run \"not false\")") + +;; String +(epoch 430) +(eval "(ocaml-run \"\\\"a\\\" ^ \\\"b\\\"\")") +(epoch 431) +(eval "(ocaml-run \"\\\"hello\\\" ^ \\\" \\\" ^ \\\"world\\\"\")") + +;; Conditional +(epoch 440) +(eval "(ocaml-run \"if true then 1 else 2\")") +(epoch 441) +(eval "(ocaml-run \"if 1 > 2 then 100 else 200\")") + +;; Let / lambda / app +(epoch 450) +(eval "(ocaml-run \"let x = 5 in x * 2\")") +(epoch 451) +(eval "(ocaml-run \"let f x = x + 1 in f 41\")") +(epoch 452) +(eval "(ocaml-run \"let f x y = x + y in f 3 4\")") +(epoch 453) +(eval "(ocaml-run \"(fun x -> x * x) 7\")") +(epoch 454) +(eval "(ocaml-run \"(fun x -> fun y -> x + y) 10 20\")") +(epoch 455) +(eval "(ocaml-run \"let f = fun x -> x + 1 in f 9\")") + +;; Closures capture +(epoch 460) +(eval "(ocaml-run \"let x = 10 in let f y = x + y in f 5\")") +(epoch 461) +(eval "(ocaml-run \"let make_adder n = fun x -> n + x in (make_adder 100) 1\")") + +;; Recursion +(epoch 470) +(eval "(ocaml-run \"let rec fact n = if n = 0 then 1 else n * fact (n - 1) in fact 5\")") +(epoch 471) +(eval "(ocaml-run \"let rec fib n = if n < 2 then n else fib (n - 1) + fib (n - 2) in fib 10\")") +(epoch 472) +(eval "(ocaml-run \"let rec sum n = if n = 0 then 0 else n + sum (n - 1) in sum 100\")") + +;; Sequence +(epoch 480) +(eval "(ocaml-run \"1; 2; 3\")") +(epoch 481) +(eval "(ocaml-run \"begin 10 end\")") + +;; Programs (top-level decls) +(epoch 490) +(eval "(ocaml-run-program \"let x = 1;; let y = 2;; x + y\")") +(epoch 491) +(eval "(ocaml-run-program \"let rec fact n = if n = 0 then 1 else n * fact (n - 1);; fact 6\")") +(epoch 492) +(eval "(ocaml-run-program \"let inc x = x + 1;; let double x = x * 2;; double (inc 4)\")") + +;; Pipe +(epoch 495) +(eval "(ocaml-run \"let f x = x * 2 in 5 |> f\")") + EPOCHS OUTPUT=$(timeout 60 "$SX_SERVER" < "$TMPFILE" 2>/dev/null) @@ -510,6 +618,71 @@ check 327 "trailing ; OK" '("seq" ("int" 1) ("int" 2))' check 328 "begin a; end singleton seq" '("seq" ("var" "a"))' check 329 "match clause body absorbs ;" '("case" ("pwild") ("seq" ("var" "a") ("var" "b")))' +# ── Phase 2: evaluator ────────────────────────────────────────── +# atoms +check 400 "eval int" '42' +check 401 "eval float" '3.14' +check 402 "eval true" 'true' +check 403 "eval false" 'false' +check 404 "eval string" '"hi"' + +# arithmetic +check 410 "eval 1+2" '3' +check 411 "eval 10-3" '7' +check 412 "eval 4*5" '20' +check 413 "eval 20/4" '5' +check 414 "eval 10 mod 3" '1' +check 415 "eval 2 ** 10" '1024' +check 416 "eval (1+2)*3" '9' +check 417 "eval 1+2*3 prec" '7' +check 418 "eval -5+10" '5' + +# comparison & boolean +check 420 "eval 1<2" 'true' +check 421 "eval 3>2" 'true' +check 422 "eval 2=2" 'true' +check 423 "eval 1<>2" 'true' +check 424 "eval true && false" 'false' +check 425 "eval true || false" 'true' +check 426 "eval not false" 'true' + +# string +check 430 'eval "a" ^ "b"' '"ab"' +check 431 "eval string concat 3" '"hello world"' + +# conditional +check 440 "eval if true 1 else 2" '1' +check 441 "eval if 1>2 100 else 200" '200' + +# let / lambda / app +check 450 "eval let x=5 x*2" '10' +check 451 "eval let f x = x+1; f 41" '42' +check 452 "eval let f x y = x+y; f 3 4" '7' +check 453 "eval (fun x -> x*x) 7" '49' +check 454 "eval curried lambdas" '30' +check 455 "eval named lambda" '10' + +# closures +check 460 "eval closure capture" '15' +check 461 "eval make_adder" '101' + +# recursion +check 470 "eval fact 5" '120' +check 471 "eval fib 10" '55' +check 472 "eval sum 100" '5050' + +# sequence +check 480 "eval 1; 2; 3 → 3" '3' +check 481 "eval begin 10 end" '10' + +# programs +check 490 "run-prog x+y" '3' +check 491 "run-prog fact 6" '720' +check 492 "run-prog inc + double" '10' + +# pipe +check 495 "eval x |> f" '10' + TOTAL=$((PASS + FAIL)) if [ $FAIL -eq 0 ]; then echo "ok $PASS/$TOTAL OCaml-on-SX tests passed" diff --git a/plans/ocaml-on-sx.md b/plans/ocaml-on-sx.md index 04c61365..01ab6dfd 100644 --- a/plans/ocaml-on-sx.md +++ b/plans/ocaml-on-sx.md @@ -144,13 +144,15 @@ SX CEK evaluator (both JS and OCaml hosts) ### Phase 2 — Core evaluator (untyped) -- [ ] `ocaml-eval` entry: walks OCaml AST, produces SX values. -- [ ] `let`/`let rec`/`let ... in` (mutually recursive with `and`). -- [ ] Lambda + application (curried by default — auto-curry multi-param defs). -- [ ] `fun`/`function` (single-arg lambda with immediate match on arg). -- [ ] `if`/`then`/`else`, `begin`/`end`, sequence `;`. -- [ ] Arithmetic, comparison, boolean ops, string `^`, `mod`. -- [ ] Unit `()` value; `ignore`. +- [x] `ocaml-eval` entry: walks OCaml AST, produces SX values. +- [~] `let`/`let rec`/`let ... in` (single-binding done; mutually recursive + `and` deferred). +- [x] Lambda + application (curried by default — auto-curry multi-param defs). +- [ ] `fun`/`function` (single-arg lambda with immediate match on arg). _(`fun` + done; `function` blocked on parser support.)_ +- [x] `if`/`then`/`else`, `begin`/`end`, sequence `;`. +- [x] Arithmetic, comparison, boolean ops, string `^`, `mod`. +- [x] Unit `()` value; `ignore`. - [ ] References: `ref`, `!`, `:=`. - [ ] Mutable record fields. - [ ] `for i = lo to hi do ... done` loop; `while cond do ... done`. @@ -315,6 +317,16 @@ the "mother tongue" closure: OCaml → SX → OCaml. This means: _Newest first._ +- 2026-05-08 Phase 2 — `lib/ocaml/eval.sx`: ocaml-eval + ocaml-run + + ocaml-run-program. Coverage: atoms, var lookup, :app (curried), + :op (arithmetic/comparison/boolean/^/mod/::/|>), :neg, :not, :if, + :seq, :tuple, :list, :fun (auto-curried host-SX closures), :let, + :let-rec (recursive knot via one-element-list mutable cell). Initial + env exposes `not`/`succ`/`pred`/`abs`/`max`/`min`/`fst`/`snd`/`ignore` + as host-SX functions. Tests: literals, arithmetic, comparison, boolean, + string concat, conditionals, lambda + closures + recursion (fact 5, + fib 10, sum 100), sequences, top-level program decls, |> pipe. 165/165 + passing (+42). - 2026-05-07 Phase 1 — sequence operator `;`. Lowest-precedence binary; `e1; e2; e3` → `(:seq e1 e2 e3)`. Two-phase grammar: `parse-expr-no-seq` is the prior expression entry point; new `parse-expr` wraps it with