diff --git a/lib/ocaml/eval.sx b/lib/ocaml/eval.sx index e1b67468..87e55790 100644 --- a/lib/ocaml/eval.sx +++ b/lib/ocaml/eval.sx @@ -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") diff --git a/lib/ocaml/parser.sx b/lib/ocaml/parser.sx index cfbff29f..e425d6e4 100644 --- a/lib/ocaml/parser.sx +++ b/lib/ocaml/parser.sx @@ -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 () diff --git a/lib/ocaml/test.sh b/lib/ocaml/test.sh index 1501d238..bb87b15e 100755 --- a/lib/ocaml/test.sh +++ b/lib/ocaml/test.sh @@ -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" diff --git a/plans/ocaml-on-sx.md b/plans/ocaml-on-sx.md index 7d0d292e..64922541 100644 --- a/plans/ocaml-on-sx.md +++ b/plans/ocaml-on-sx.md @@ -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.