diff --git a/lib/ocaml/eval.sx b/lib/ocaml/eval.sx index 660f2e98..fec7cd8b 100644 --- a/lib/ocaml/eval.sx +++ b/lib/ocaml/eval.sx @@ -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 diff --git a/lib/ocaml/parser.sx b/lib/ocaml/parser.sx index de78484b..dd5a24a7 100644 --- a/lib/ocaml/parser.sx +++ b/lib/ocaml/parser.sx @@ -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 diff --git a/lib/ocaml/test.sh b/lib/ocaml/test.sh index e5f42a0b..776cd7b1 100755 --- a/lib/ocaml/test.sh +++ b/lib/ocaml/test.sh @@ -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" diff --git a/plans/ocaml-on-sx.md b/plans/ocaml-on-sx.md index b52ae339..50630441 100644 --- a/plans/ocaml-on-sx.md +++ b/plans/ocaml-on-sx.md @@ -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