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
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:
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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"
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user