ocaml: phase 2 try/with + raise (+6 tests, 204 total)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 57s
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:
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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"
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user