ocaml: phase 2 try/with + raise (+6 tests, 204 total)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 57s

Parser: try EXPR with | pat -> handler | ... -> (:try EXPR CLAUSES).
Eval delegates to SX guard with else matching the raised value against
clause patterns; re-raises on no-match. raise/failwith/invalid_arg
shipped as builtins. failwith "msg" raises ("Failure" msg) so
| Failure msg -> ... patterns match.
This commit is contained in:
2026-05-08 08:20:11 +00:00
parent 937342bbf0
commit 6a1f63f0d1
4 changed files with 82 additions and 2 deletions

View File

@@ -41,7 +41,13 @@
(list "ignore" (fn (x) nil))
;; References. A ref cell is a one-element list; ! reads it and
;; := mutates it via set-nth!.
(list "ref" (fn (x) (list x))))))
(list "ref" (fn (x) (list x)))
;; Exceptions: `raise e` invokes the host-SX raise; values are
;; tagged like other ctors so `try ... with | Exn x -> handler`
;; can pattern-match them.
(list "raise" (fn (e) (raise e)))
(list "failwith" (fn (msg) (raise (list "Failure" msg))))
(list "invalid_arg" (fn (msg) (raise (list "Invalid_argument" msg)))))))
(define ocaml-env-lookup
(fn (env name)
@@ -342,6 +348,28 @@
(loop)))))
(loop)))))
nil)))
((= tag "try")
;; (:try EXPR CLAUSES) — evaluate EXPR; if it raises, match the
;; raised value against CLAUSES. Re-raise on no-match.
(let ((expr (nth ast 1)) (clauses (nth ast 2)) (env-cap env))
(guard (e
(else
(begin
(define try-clauses
(fn (cs)
(cond
((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))))))))))
(try-clauses clauses))))
(ocaml-eval expr env-cap))))
((= tag "while")
(let ((cond-ast (nth ast 1)) (body (nth ast 2)))
(begin

View File

@@ -573,6 +573,28 @@
(begin (advance-tok!) (one) (loop)))))
(loop)
(cons :match (cons scrut (list cases)))))))))
(define parse-try
(fn ()
(let ((expr (parse-expr-no-seq)))
(begin
(consume! "keyword" "with")
(when (at-op? "|") (advance-tok!))
(let ((cases (list)))
(begin
(define one
(fn ()
(let ((p (parse-pattern)))
(begin
(consume! "op" "->")
(let ((body (parse-expr)))
(append! cases (list :case p body)))))))
(one)
(define loop
(fn ()
(when (at-op? "|")
(begin (advance-tok!) (one) (loop)))))
(loop)
(list :try expr cases)))))))
(define parse-function
(fn ()
;; `function | pat -> body | …` ≡ fun x -> match x with | pat -> body
@@ -634,6 +656,7 @@
((at-kw? "function") (begin (advance-tok!) (parse-function)))
((at-kw? "for") (begin (advance-tok!) (parse-for)))
((at-kw? "while") (begin (advance-tok!) (parse-while)))
((at-kw? "try") (begin (advance-tok!) (parse-try)))
(else (parse-tuple)))))
(set!
parse-expr

View File

@@ -517,6 +517,20 @@ cat > "$TMPFILE" << 'EPOCHS'
(epoch 643)
(eval "(ocaml-run-program \"let rec map f = function | [] -> [] | h :: t -> f h :: map f t;; map (fun x -> x * x) [1; 2; 3; 4]\")")
;; ── try / with / raise ─────────────────────────────────────────
(epoch 660)
(eval "(ocaml-run \"try 1 + 2 with | _ -> 0\")")
(epoch 661)
(eval "(ocaml-run \"try raise (Foo 5) with | Foo x -> x | Bar -> 99\")")
(epoch 662)
(eval "(ocaml-run \"try raise Bar with | Foo x -> x | Bar -> 99\")")
(epoch 663)
(eval "(ocaml-run \"try failwith \\\"oops\\\" with | Failure msg -> msg\")")
(epoch 664)
(eval "(ocaml-run \"try (raise (Foo 1); 999) with | Foo x -> x + 100\")")
(epoch 665)
(eval "(ocaml-run \"let f x = if x < 0 then raise (NegArg x) else x * 2 in try f (-5) with | NegArg n -> n\")")
EPOCHS
OUTPUT=$(timeout 60 "$SX_SERVER" < "$TMPFILE" 2>/dev/null)
@@ -824,6 +838,14 @@ check 641 "function None=0" '0'
check 642 "rec function len" '3'
check 643 "rec function map x*x" '(1 4 9 16)'
# ── try / with / raise ──────────────────────────────────────────
check 660 "try success" '3'
check 661 "try Foo caught" '5'
check 662 "try Bar caught" '99'
check 663 "try failwith" '"oops"'
check 664 "try sequence raises" '101'
check 665 "raise from function" '-5'
TOTAL=$((PASS + FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL OCaml-on-SX tests passed"

View File

@@ -156,7 +156,8 @@ SX CEK evaluator (both JS and OCaml hosts)
- [ ] Mutable record fields.
- [x] `for i = lo to hi do ... done` loop; `while cond do ... done` (incl.
`downto` direction).
- [ ] `try`/`with` — maps to SX `guard`; `raise` via perform.
- [x] `try`/`with` — maps to SX `guard`; `raise` is a builtin that calls
host SX `raise`. `failwith` and `invalid_arg` ship as builtins.
- [ ] Tests in `lib/ocaml/tests/eval.sx` — 50+ tests, pure + imperative.
### Phase 3 — ADTs + pattern matching
@@ -320,6 +321,12 @@ the "mother tongue" closure: OCaml → SX → OCaml. This means:
_Newest first._
- 2026-05-08 Phase 2 — `try`/`with` + `raise` builtin. Parser produces
`(:try EXPR CLAUSES)`; eval delegates to SX `guard` with `else`
matching the raised value against clause patterns and re-raising on
no-match. `raise`/`failwith`/`invalid_arg` exposed as builtins;
failwith builds `("Failure" msg)` so `Failure msg -> ...` patterns
match. 204/204 (+6).
- 2026-05-08 Phase 2 — `function | pat -> body | …` parser + eval.
Sugar for `fun x -> match x with | …`. AST: `(:function CLAUSES)`
evaluated to a unary closure that runs `ocaml-match-clauses` on the