coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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
Details

Browse Source 
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:
giles
2026-05-08 20:36:02 +00:00
parent 029c1783f4
commit c7d8b7dd62
4 changed files with 49 additions and 11 deletions
Download Patch File Download Diff File Expand all files Collapse all files

32
lib/ocaml/eval.sx
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")