diff --git a/lib/ocaml/eval.sx b/lib/ocaml/eval.sx index f7dd1f8a..d28e950b 100644 --- a/lib/ocaml/eval.sx +++ b/lib/ocaml/eval.sx @@ -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 diff --git a/lib/ocaml/parser.sx b/lib/ocaml/parser.sx index 8e93415a..d55d101e 100644 --- a/lib/ocaml/parser.sx +++ b/lib/ocaml/parser.sx @@ -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 diff --git a/lib/ocaml/test.sh b/lib/ocaml/test.sh index ac93a4a7..df1039aa 100755 --- a/lib/ocaml/test.sh +++ b/lib/ocaml/test.sh @@ -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" diff --git a/plans/ocaml-on-sx.md b/plans/ocaml-on-sx.md index 6cfb681c..e9609dd7 100644 --- a/plans/ocaml-on-sx.md +++ b/plans/ocaml-on-sx.md @@ -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