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))
|
(list "ignore" (fn (x) nil))
|
||||||
;; References. A ref cell is a one-element list; ! reads it and
|
;; References. A ref cell is a one-element list; ! reads it and
|
||||||
;; := mutates it via set-nth!.
|
;; := 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
|
(define ocaml-env-lookup
|
||||||
(fn (env name)
|
(fn (env name)
|
||||||
@@ -342,6 +348,28 @@
|
|||||||
(loop)))))
|
(loop)))))
|
||||||
(loop)))))
|
(loop)))))
|
||||||
nil)))
|
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")
|
((= tag "while")
|
||||||
(let ((cond-ast (nth ast 1)) (body (nth ast 2)))
|
(let ((cond-ast (nth ast 1)) (body (nth ast 2)))
|
||||||
(begin
|
(begin
|
||||||
|
|||||||
@@ -573,6 +573,28 @@
|
|||||||
(begin (advance-tok!) (one) (loop)))))
|
(begin (advance-tok!) (one) (loop)))))
|
||||||
(loop)
|
(loop)
|
||||||
(cons :match (cons scrut (list cases)))))))))
|
(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
|
(define parse-function
|
||||||
(fn ()
|
(fn ()
|
||||||
;; `function | pat -> body | …` ≡ fun x -> match x with | pat -> body
|
;; `function | pat -> body | …` ≡ fun x -> match x with | pat -> body
|
||||||
@@ -634,6 +656,7 @@
|
|||||||
((at-kw? "function") (begin (advance-tok!) (parse-function)))
|
((at-kw? "function") (begin (advance-tok!) (parse-function)))
|
||||||
((at-kw? "for") (begin (advance-tok!) (parse-for)))
|
((at-kw? "for") (begin (advance-tok!) (parse-for)))
|
||||||
((at-kw? "while") (begin (advance-tok!) (parse-while)))
|
((at-kw? "while") (begin (advance-tok!) (parse-while)))
|
||||||
|
((at-kw? "try") (begin (advance-tok!) (parse-try)))
|
||||||
(else (parse-tuple)))))
|
(else (parse-tuple)))))
|
||||||
(set!
|
(set!
|
||||||
parse-expr
|
parse-expr
|
||||||
|
|||||||
@@ -517,6 +517,20 @@ cat > "$TMPFILE" << 'EPOCHS'
|
|||||||
(epoch 643)
|
(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]\")")
|
(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
|
EPOCHS
|
||||||
|
|
||||||
OUTPUT=$(timeout 60 "$SX_SERVER" < "$TMPFILE" 2>/dev/null)
|
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 642 "rec function len" '3'
|
||||||
check 643 "rec function map x*x" '(1 4 9 16)'
|
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))
|
TOTAL=$((PASS + FAIL))
|
||||||
if [ $FAIL -eq 0 ]; then
|
if [ $FAIL -eq 0 ]; then
|
||||||
echo "ok $PASS/$TOTAL OCaml-on-SX tests passed"
|
echo "ok $PASS/$TOTAL OCaml-on-SX tests passed"
|
||||||
|
|||||||
@@ -156,7 +156,8 @@ SX CEK evaluator (both JS and OCaml hosts)
|
|||||||
- [ ] Mutable record fields.
|
- [ ] Mutable record fields.
|
||||||
- [x] `for i = lo to hi do ... done` loop; `while cond do ... done` (incl.
|
- [x] `for i = lo to hi do ... done` loop; `while cond do ... done` (incl.
|
||||||
`downto` direction).
|
`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.
|
- [ ] Tests in `lib/ocaml/tests/eval.sx` — 50+ tests, pure + imperative.
|
||||||
|
|
||||||
### Phase 3 — ADTs + pattern matching
|
### Phase 3 — ADTs + pattern matching
|
||||||
@@ -320,6 +321,12 @@ the "mother tongue" closure: OCaml → SX → OCaml. This means:
|
|||||||
|
|
||||||
_Newest first._
|
_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.
|
- 2026-05-08 Phase 2 — `function | pat -> body | …` parser + eval.
|
||||||
Sugar for `fun x -> match x with | …`. AST: `(:function CLAUSES)`
|
Sugar for `fun x -> match x with | …`. AST: `(:function CLAUSES)`
|
||||||
evaluated to a unary closure that runs `ocaml-match-clauses` on the
|
evaluated to a unary closure that runs `ocaml-match-clauses` on the
|
||||||
|
|||||||
Reference in New Issue
Block a user