diff --git a/lib/ocaml/eval.sx b/lib/ocaml/eval.sx index b92da38f..fe38fed5 100644 --- a/lib/ocaml/eval.sx +++ b/lib/ocaml/eval.sx @@ -224,6 +224,33 @@ (ocaml-env-extend env (nth pat 1) val)) ((= tag "plit") (if (= (ocaml-eval-lit (nth pat 1)) val) env ocaml-match-fail)) + ((= tag "precord") + ;; (:precord (FIELDNAME PAT) ...) — val must be a dict with each + ;; named field; each pat must match the field's value. + (cond + ((not (dict? val)) ocaml-match-fail) + (else + (let ((fields (rest pat)) (env-cur env) (failed false)) + (begin + (define one-field + (fn (kv) + (let ((k (first kv)) (p (nth kv 1))) + (cond + ((not (has-key? val k)) + (set! failed true)) + (else + (let ((env2 (ocaml-match-pat p (get val k) env-cur))) + (cond + ((= env2 ocaml-match-fail) (set! failed true)) + (else (set! env-cur env2))))))))) + (define loop + (fn (xs) + (when (and (not failed) (not (= xs (list)))) + (begin (one-field (first xs)) (loop (rest xs)))))) + (loop fields) + (cond + (failed ocaml-match-fail) + (else env-cur))))))) ((= tag "pcon") ;; (:pcon NAME PATS...) — val must be (NAME VALS...) with same arity. (let ((name (nth pat 1)) (arg-pats (rest (rest pat)))) diff --git a/lib/ocaml/parser.sx b/lib/ocaml/parser.sx index 9dc08026..228059fb 100644 --- a/lib/ocaml/parser.sx +++ b/lib/ocaml/parser.sx @@ -250,6 +250,29 @@ (loop) (consume! "op" "]") (cons :plist items))))))) + ((and (= tt "op") (= tv "{")) + ;; Record pattern: { f1 = pat1; f2 = pat2; ... } + (begin + (advance-tok!) + (let ((fields (list))) + (begin + (define one + (fn () + (let ((fname (ocaml-tok-value (consume! "ident" nil)))) + (begin + (consume! "op" "=") + (let ((fp (parse-pattern))) + (append! fields (list fname fp))))))) + (one) + (define more + (fn () + (when (at-op? ";") + (begin (advance-tok!) + (when (not (at-op? "}")) + (begin (one) (more))))))) + (more) + (consume! "op" "}") + (cons :precord fields))))) (else (error (str diff --git a/lib/ocaml/test.sh b/lib/ocaml/test.sh index 413f0645..3ee3766e 100755 --- a/lib/ocaml/test.sh +++ b/lib/ocaml/test.sh @@ -946,6 +946,16 @@ cat > "$TMPFILE" << 'EPOCHS' (epoch 2503) (eval "(ocaml-run \"match \`Pair (1, 2) with | \`Pair (a, b) -> a + b\")") +;; ── Record patterns ─────────────────────────────────────────── +(epoch 2600) +(eval "(ocaml-run \"match { x = 1; y = 2 } with | { x = a; y = b } -> a + b\")") +(epoch 2601) +(eval "(ocaml-run \"match { name = \\\"Bob\\\"; age = 30 } with | { name = n; age = a } -> a\")") +(epoch 2602) +(eval "(ocaml-run \"match { x = 1; y = 2 } with | { x = 1; y = y } -> y | _ -> 0\")") +(epoch 2603) +(eval "(ocaml-run \"match { x = 5; y = 2 } with | { x = 1; y = y } -> y | _ -> 0\")") + EPOCHS OUTPUT=$(timeout 180 "$SX_SERVER" < "$TMPFILE" 2>/dev/null) @@ -1496,6 +1506,12 @@ check 2501 "polyvar Some 42" '("Some" 42)' check 2502 "polyvar match" '1' check 2503 "polyvar Pair (a,b)" '3' +# ── Record patterns ──────────────────────────────────────────── +check 2600 "match record bind both" '3' +check 2601 "match record name+age" '30' +check 2602 "match record literal x=1" '2' +check 2603 "match record literal fail" '0' + 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 9e5ba3b5..ae745d26 100644 --- a/plans/ocaml-on-sx.md +++ b/plans/ocaml-on-sx.md @@ -134,13 +134,12 @@ SX CEK evaluator (both JS and OCaml hosts) `type`/`module`/`exception`/`open`/`include` decls, `try`/`with`, `function`, record literals/updates, field access, `and` mutually-recursive bindings.)_ -- [~] **Patterns:** constructor (nullary + with args, incl. flattened tuple - args `Pair (a, b)` → `(:pcon "Pair" PA PB)`), literal (int/string/char/ - bool/unit), variable, wildcard `_`, tuple, list cons `::`, list - literal, `as` binding (`pat as name`). Match clauses support `when` - guard via `(:case-when PAT GUARD BODY)`. _(Pending: record patterns, - or-pattern `P1 | P2` — ambiguous with clause separator without - lookahead.)_ +- [x] **Patterns:** constructor (nullary + with args, incl. flattened tuple + args), literal (int/string/char/bool/unit), variable, wildcard `_`, + tuple, list cons `::`, list literal, record `{ f = pat; … }`, + `as` binding. Match clauses support `when` guard via + `(:case-when PAT GUARD BODY)`. _(Pending: or-pattern `P1 | P2` — + ambiguous with clause separator without lookahead.)_ - [ ] OCaml is **not** indentation-sensitive — no layout algorithm needed. - [ ] Tests in `lib/ocaml/tests/parse.sx` — 50+ round-trip parse tests. @@ -377,6 +376,12 @@ the "mother tongue" closure: OCaml → SX → OCaml. This means: _Newest first._ +- 2026-05-08 Phase 1+3 — record patterns `{ f = pat; … }` (+4 tests, + 386 total). Parser adds `(:precord (FIELD PAT) …)` alongside + the existing record-literal `{` handling. Eval matches against + dicts: required fields must be present and each pat must match the + value. Can mix with literals: `{ x = 1; y = y }` matches only when + x is 1. - 2026-05-08 Phase 5.1 — expr_eval.ml baseline (9/9 pass). A tiny arithmetic-expression evaluator using ADT (`type expr = Lit | Add | Mul | Neg`) + recursive eval + pattern match — exercises the full