From 9b833a9442158f8664a0c81debc18073cce779f3 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 08:02:56 +0000 Subject: [PATCH] ocaml: phase 3 pattern matching + constructors (+18 tests, 183 total) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Constructor app: (:app (:con NAME) arg) -> (NAME …args). Tuple args flatten so Pair(a,b) -> ("Pair" a b), matching the parser's pattern flatten. Standalone (:con NAME) -> (NAME) nullary. Pattern matcher: :pwild, :pvar, :plit, :pcon (head + arity), :pcons (decompose), :plist (length match), :ptuple (after tuple tag). Match walks clauses until first success; runtime error on exhaustion. Recursive list functions (len, sum, fact) work end-to-end. --- lib/ocaml/eval.sx | 135 ++++++++++++++++++++++++++++++++++++++++++- lib/ocaml/test.sh | 84 +++++++++++++++++++++++++++ plans/ocaml-on-sx.md | 25 ++++++-- 3 files changed, 237 insertions(+), 7 deletions(-) diff --git a/lib/ocaml/eval.sx b/lib/ocaml/eval.sx index 8fcb3d16..bebe0d26 100644 --- a/lib/ocaml/eval.sx +++ b/lib/ocaml/eval.sx @@ -62,6 +62,115 @@ (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-eval + (fn (scrut-ast clauses env) + (let ((val (ocaml-eval scrut-ast 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))))) + ;; 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 @@ -153,10 +262,30 @@ (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-val (ocaml-eval (nth ast 1) env)) - (arg-val (ocaml-eval (nth ast 2) env))) - (fn-val arg-val))) + (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 "let") (let ((name (nth ast 1)) (params (nth ast 2)) (rhs (nth ast 3)) (body (nth ast 4))) diff --git a/lib/ocaml/test.sh b/lib/ocaml/test.sh index 83dc82a6..be643746 100755 --- a/lib/ocaml/test.sh +++ b/lib/ocaml/test.sh @@ -430,6 +430,57 @@ cat > "$TMPFILE" << 'EPOCHS' (epoch 495) (eval "(ocaml-run \"let f x = x * 2 in 5 |> f\")") +;; ── Phase 3: ADTs + match (eval) ─────────────────────────────── +;; Constructors +(epoch 500) +(eval "(ocaml-run \"None\")") +(epoch 501) +(eval "(ocaml-run \"Some 42\")") +(epoch 502) +(eval "(ocaml-run \"Some (1, 2)\")") + +;; Match — option +(epoch 510) +(eval "(ocaml-run \"match Some 5 with | None -> 0 | Some y -> y\")") +(epoch 511) +(eval "(ocaml-run \"match None with | None -> 0 | Some y -> y\")") + +;; Match — literals +(epoch 520) +(eval "(ocaml-run \"match 3 with | 1 -> 100 | 2 -> 200 | _ -> 999\")") +(epoch 521) +(eval "(ocaml-run \"match true with | true -> 1 | false -> 0\")") +(epoch 522) +(eval "(ocaml-run \"match \\\"hi\\\" with | \\\"hi\\\" -> 1 | _ -> 0\")") + +;; Match — tuples +(epoch 530) +(eval "(ocaml-run \"match (1, 2) with | (a, b) -> a + b\")") +(epoch 531) +(eval "(ocaml-run \"match (1, 2, 3) with | (a, b, c) -> a * b * c\")") + +;; Match — list cons / nil +(epoch 540) +(eval "(ocaml-run \"match [1; 2; 3] with | [] -> 0 | h :: _ -> h\")") +(epoch 541) +(eval "(ocaml-run \"match [] with | [] -> 0 | h :: _ -> h\")") +(epoch 542) +(eval "(ocaml-run \"match [1; 2; 3] with | [a; b; c] -> a + b + c | _ -> 0\")") +(epoch 543) +(eval "(ocaml-run \"let rec len lst = match lst with | [] -> 0 | _ :: t -> 1 + len t in len [1; 2; 3; 4; 5]\")") +(epoch 544) +(eval "(ocaml-run \"let rec sum lst = match lst with | [] -> 0 | h :: t -> h + sum t in sum [1; 2; 3; 4; 5]\")") + +;; Match — wildcard + var +(epoch 550) +(eval "(ocaml-run \"match 99 with | _ -> 1\")") +(epoch 551) +(eval "(ocaml-run \"match 99 with | x -> x + 1\")") + +;; Constructors with tuple args +(epoch 560) +(eval "(ocaml-run \"match Pair (1, 2) with | Pair (a, b) -> a * b\")") + EPOCHS OUTPUT=$(timeout 60 "$SX_SERVER" < "$TMPFILE" 2>/dev/null) @@ -683,6 +734,39 @@ check 492 "run-prog inc + double" '10' # pipe check 495 "eval x |> f" '10' +# ── Phase 3: ADTs + match (eval) ──────────────────────────────── +# constructors +check 500 "eval None" '("None")' +check 501 "eval Some 42" '("Some" 42)' +check 502 "eval Pair tuple-arg" '("Some" 1 2)' + +# option match +check 510 "match Some 5 -> 5" '5' +check 511 "match None -> 0" '0' + +# literal match +check 520 "match 3 -> _ -> 999" '999' +check 521 "match bool true" '1' +check 522 "match string lit" '1' + +# tuple match +check 530 "match (1,2)" '3' +check 531 "match (1,2,3)" '6' + +# list match +check 540 "match list cons head" '1' +check 541 "match empty list" '0' +check 542 "match list literal pat" '6' +check 543 "match recursive len" '5' +check 544 "match recursive sum" '15' + +# wildcard + var +check 550 "match _ -> 1" '1' +check 551 "match x -> x+1" '100' + +# ctor with tuple arg +check 560 "Pair(a,b) → a*b" '2' + 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 01ab6dfd..e8ce1135 100644 --- a/plans/ocaml-on-sx.md +++ b/plans/ocaml-on-sx.md @@ -162,10 +162,13 @@ SX CEK evaluator (both JS and OCaml hosts) ### Phase 3 — ADTs + pattern matching - [ ] `type` declarations: `type t = A | B of t1 * t2 | C of { x: int }`. -- [ ] Constructors as tagged lists: `A` → `(:A)`, `B(1, "x")` → `(:B 1 "x")`. -- [ ] `match`/`with`: constructor, literal, variable, wildcard, tuple, list cons/nil, - `as` binding, or-patterns, nested patterns, `when` guard. -- [ ] Exhaustiveness: runtime error on incomplete match (no compile-time check yet). + _(Parser + evaluator currently inferred-arity at runtime; type decls + pending.)_ +- [x] Constructors as tagged lists: `A` → `("A")`, `B(1, "x")` → `("B" 1 "x")`. +- [~] `match`/`with`: constructor, literal, variable, wildcard, tuple, list + cons/nil, nested patterns. _(Pending: `as` binding, or-patterns, + `when` guard.)_ +- [x] Exhaustiveness: runtime error on incomplete match (no compile-time check yet). - [ ] Built-in types: `option` (`None`/`Some`), `result` (`Ok`/`Error`), `list` (nil/cons), `bool`, `unit`, `exn`. - [ ] `exception` declarations; built-in: `Not_found`, `Invalid_argument`, @@ -317,6 +320,20 @@ the "mother tongue" closure: OCaml → SX → OCaml. This means: _Newest first._ +- 2026-05-08 Phase 3 — pattern matching evaluator + constructors (+18 + tests, 183 total). Constructor application: `(:app (:con NAME) arg)` + builds a tagged list `(NAME …args)` with tuple args flattened (so + `Pair (a, b)` → `("Pair" a b)` matches the parser's pattern flatten). + Standalone ctor `(:con NAME)` → `(NAME)` (nullary). Pattern matcher: + :pwild / :pvar / :plit (unboxed compare) / :pcon (head + arity match) / + :pcons (cons-decompose) / :plist (length+items) / :ptuple (after `tuple` + tag). Match drives clauses until first success; runtime error on + exhaustion. Tested with option match, literal match, tuple match, + recursive list functions (`len`, `sum`), nested ctor (`Pair(a,b)`). + Note: arity flattening happens for any tuple-arg ctor — without ADT + declarations there's no way to distinguish `Some (1,2)` (single tuple + payload) from `Pair (1,2)` (two-arg ctor). All-flatten convention is + consistent across parser + evaluator. - 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,