ocaml: phase 1+3 record patterns { f = pat } (+4 tests, 386 total)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 48s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 48s
Parser: { f1 = pat; f2 = pat; ... } in pattern position emits
(:precord (FIELDNAME PAT)...). Mixed with the existing { in
expression position via the at-pattern-atom? whitelist.
Eval: :precord matches against a dict; required fields must be present
and each pat must match the field's value. Can mix literal+var:
'match { x = 1; y = y } with | { x = 1; y = y } -> y' matches only
when x is 1.
This commit is contained in:
@@ -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))))
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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"
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user