ocaml: phase 3 'as' alias + 'when' guard in match (+6 tests, 295 total)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 50s

Pattern parser top wraps cons-pat with 'as ident' -> (:pas PAT NAME).
Match clause parser consumes optional 'when GUARD-EXPR' before -> and
emits (:case-when PAT GUARD BODY) instead of :case.

Eval: :pas matches inner pattern then binds the alias name; case-when
checks the guard after a successful match and falls through to the next
clause if the guard is false.

Or-patterns deferred — ambiguous with clause separator without
parens-only support.
This commit is contained in:
2026-05-08 12:28:07 +00:00
parent 7fb65cd26a
commit 851e0585cf
4 changed files with 84 additions and 11 deletions

View File

@@ -193,6 +193,13 @@
(= (len (rest val)) (len arg-pats)))
(ocaml-match-list arg-pats (rest val) env))
(else ocaml-match-fail))))
((= tag "pas")
;; (:pas INNER NAME) — match inner pattern, also bind NAME → val.
(let ((inner (nth pat 1)) (alias (nth pat 2)))
(let ((env2 (ocaml-match-pat inner val env)))
(cond
((= env2 ocaml-match-fail) ocaml-match-fail)
(else (ocaml-env-extend env2 alias val))))))
((= tag "pcons")
;; (:pcons HEAD TAIL) — val must be a non-empty list.
(cond
@@ -239,11 +246,24 @@
(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))))))))))
(let ((ctag (nth clause 0)))
(cond
((= ctag "case")
(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))))))
((= ctag "case-when")
(let ((pat (nth clause 1))
(guard (nth clause 2))
(body (nth clause 3)))
(let ((env2 (ocaml-match-pat pat val env)))
(cond
((= env2 ocaml-match-fail) (try-clauses (rest cs)))
((not (ocaml-eval guard env2)) (try-clauses (rest cs)))
(else (ocaml-eval body env2))))))
(else (error (str "ocaml-match: bad clause tag " ctag))))))))))
(try-clauses clauses))))
(define ocaml-match-eval

View File

@@ -281,7 +281,20 @@
(advance-tok!)
(list :pcons lhs (parse-pattern-cons))))
(else lhs)))))
(set! parse-pattern (fn () (parse-pattern-cons)))
;; Top-level pattern is the cons-pat layer wrapped with optional
;; `pat as name` aliasing. Or-patterns are not supported at the
;; top level due to ambiguity with the match clause separator;
;; use `(A | B)` if needed in the future via a parens-only or.
(set! parse-pattern
(fn ()
(let ((p (parse-pattern-cons)))
(cond
((at-kw? "as")
(begin
(advance-tok!)
(let ((n (ocaml-tok-value (consume! "ident" nil))))
(list :pas p n))))
(else p)))))
(define peek-tok-at
(fn (n)
@@ -673,12 +686,20 @@
(fn
()
(let
((p (parse-pattern)))
((p (parse-pattern)) (guard nil))
(begin
(when (at-kw? "when")
(begin
(advance-tok!)
(set! guard (parse-expr-no-seq))))
(consume! "op" "->")
(let
((body (parse-expr)))
(append! cases (list :case p body)))))))
(cond
((= guard nil)
(append! cases (list :case p body)))
(else
(append! cases (list :case-when p guard body)))))))))
(one)
(define
loop

View File

@@ -728,6 +728,20 @@ cat > "$TMPFILE" << 'EPOCHS'
(epoch 1105)
(eval "(ocaml-run-program \"let r = { x = 1; y = 2 };; r.x + r.y\")")
;; ── as / when in match ─────────────────────────────────────────
(epoch 1200)
(eval "(ocaml-run \"match Some 5 with | Some x as p -> x | None -> 0\")")
(epoch 1201)
(eval "(ocaml-run \"match 5 with | n when n > 0 -> 1 | n when n < 0 -> -1 | _ -> 0\")")
(epoch 1202)
(eval "(ocaml-run \"match (-3) with | n when n > 0 -> 1 | n when n < 0 -> -1 | _ -> 0\")")
(epoch 1203)
(eval "(ocaml-run \"match 0 with | n when n > 0 -> 1 | n when n < 0 -> -1 | _ -> 0\")")
(epoch 1204)
(eval "(ocaml-run \"match (Some 7) with | None -> 0 | Some x when x > 5 -> x * 10 | Some x -> x\")")
(epoch 1205)
(eval "(ocaml-run \"match (Some 3) with | None -> 0 | Some x when x > 5 -> x * 10 | Some x -> x\")")
EPOCHS
OUTPUT=$(timeout 180 "$SX_SERVER" < "$TMPFILE" 2>/dev/null)
@@ -1153,6 +1167,14 @@ check 1103 "record string field" '"Bob"'
check 1104 "record int field" '30'
check 1105 "top-level record decl" '3'
# ── as / when in match ──────────────────────────────────────────
check 1200 "Some x as p" '5'
check 1201 "when sign +" '1'
check 1202 "when sign -" '-1'
check 1203 "when sign 0" '0'
check 1204 "when guard fires" '70'
check 1205 "when guard skips" '3'
TOTAL=$((PASS + FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL OCaml-on-SX tests passed"

View File

@@ -136,9 +136,11 @@ SX CEK evaluator (both JS and OCaml hosts)
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.
_(Pending: record patterns, `as` binding, or-pattern `P1 | P2`, `when`
guard.)_
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.)_
- [ ] OCaml is **not** indentation-sensitive — no layout algorithm needed.
- [ ] Tests in `lib/ocaml/tests/parse.sx` — 50+ round-trip parse tests.
@@ -355,6 +357,14 @@ the "mother tongue" closure: OCaml → SX → OCaml. This means:
_Newest first._
- 2026-05-08 Phase 3 — `as` aliases + `when` guards in match (+6 tests,
295 total). Parser: pattern parser wraps with `as ident` → `(:pas
PAT NAME)`. Match's `one` consumes optional `when GUARD-EXPR` → emits
`(:case-when PAT GUARD BODY)` instead of `:case`. Eval `:pas` matches
inner pattern then also binds the alias name; `case-when` checks the
guard after a successful match and falls through if false. Or-pat
`(P1 | P2)` deferred — ambiguous with clause separator without
parens-only support.
- 2026-05-08 Phase 1+2 — record literals `{ x = 1; y = 2 }` and
functional update `{ r with x = 99 }`. Parser produces `(:record (F E)
...)` and `(:record-update BASE-EXPR (F E) ...)`. Eval builds a dict