ocaml: phase 2+3 'when' guard in try/with (+3 tests, 467 total)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 27s

parse-try now consumes optional 'when GUARD-EXPR' before -> and emits
(:case-when PAT GUARD BODY). Eval try clause loop dispatches on case /
case-when and falls through on guard false — same semantics as match.

Examples:
  try raise (E 5) with | E n when n > 0 -> n | _ -> 0   = 5
  try raise (E (-3)) with | E n when n > 0 -> n | _ -> 0 = 0
  try raise (E 5) with | E n when n > 100 -> n | E n -> n + 1000  = 1005
This commit is contained in:
2026-05-08 20:36:02 +00:00
parent 029c1783f4
commit c7d8b7dd62
4 changed files with 49 additions and 11 deletions

View File

@@ -592,8 +592,9 @@
(loop)))))
nil)))
((= tag "try")
;; (:try EXPR CLAUSES) — evaluate EXPR; if it raises, match the
;; raised value against CLAUSES. Re-raise on no-match.
;; (:try EXPR CLAUSES) — evaluate EXPR; if it raises, match
;; the raised value against CLAUSES (case + case-when).
;; Re-raise on no-match.
(let ((expr (nth ast 1)) (clauses (nth ast 2)) (env-cap env))
(guard (e
(else
@@ -604,13 +605,26 @@
((empty? cs) (raise e))
(else
(let ((clause (first cs)))
(let ((pat (nth clause 1))
(body (nth clause 2)))
(let ((env2 (ocaml-match-pat pat e env-cap)))
(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 e env-cap)))
(cond
((= env2 ocaml-match-fail)
(try-clauses (rest cs)))
(else (ocaml-eval body env2))))))
((= ctag "case-when")
(let ((pat (nth clause 1))
(g (nth clause 2))
(body (nth clause 3)))
(let ((env2 (ocaml-match-pat pat e env-cap)))
(cond
((= env2 ocaml-match-fail) (try-clauses (rest cs)))
((not (ocaml-eval g env2)) (try-clauses (rest cs)))
(else (ocaml-eval body env2))))))
(else (raise e)))))))))
(try-clauses clauses))))
(ocaml-eval expr env-cap))))
((= tag "while")

View File

@@ -773,11 +773,18 @@
(begin
(define one
(fn ()
(let ((p (parse-pattern)))
(let ((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
(fn ()

View File

@@ -1148,6 +1148,14 @@ cat > "$TMPFILE" << 'EPOCHS'
(epoch 4402)
(eval "(ocaml-run \"(function | n when n > 0 -> 1 | n when n < 0 -> -1 | _ -> 0) 0\")")
;; ── try/with `when` guard ─────────────────────────────────────
(epoch 4500)
(eval "(ocaml-run \"try raise (E 5) with | E n when n > 0 -> n | _ -> 0\")")
(epoch 4501)
(eval "(ocaml-run \"try raise (E (-3)) with | E n when n > 0 -> n | _ -> 0\")")
(epoch 4502)
(eval "(ocaml-run \"try raise (E 5) with | E n when n > 100 -> n | E n -> n + 1000\")")
EPOCHS
OUTPUT=$(timeout 180 "$SX_SERVER" < "$TMPFILE" 2>/dev/null)
@@ -1818,6 +1826,11 @@ check 4400 "function when 5" '1'
check 4401 "function when -3" '0'
check 4402 "function sign 0" '0'
# ── try/with `when` guard ──────────────────────────────────────
check 4500 "try when guard fires" '5'
check 4501 "try when guard skips" '0'
check 4502 "try when fall through" '1005'
TOTAL=$((PASS + FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL OCaml-on-SX tests passed"

View File

@@ -407,6 +407,10 @@ _Newest first._
binary search tree (`type 'a tree = Leaf | Node of 'a * 'a tree *
'a tree`) with insert + in-order traversal. Tests parametric ADT,
recursive match, List.append, List.fold_left.
- 2026-05-08 Phase 2+3 — `try ... with | pat when GUARD -> body` guard
support (+3 tests, 467 total). parse-try mirrors match/function;
eval-try clause loop now dispatches on `case`/`case-when` and falls
through to next clause when guard is false.
- 2026-05-08 Phase 1+3 — `function | pat when GUARD -> body | …`
guard support (+3 tests, 464 total). `parse-function` mirrors the
match-clause when-handling.