From bc557a5ad2de53e7e5e7e5f749b83b4adbeba47e Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 12:37:58 +0000 Subject: [PATCH] ocaml: phase 3 exception declarations (+4 tests, 304 total) exception NAME [of TYPE] parses to (:exception-def NAME [ARG-SRC]). Runtime is a no-op: raise/match already work on tagged ctor values, so 'exception E of int;; try raise (E 5) with | E n -> n' end-to-end with zero new eval logic. --- lib/ocaml/eval.sx | 5 +++++ lib/ocaml/parser.sx | 32 ++++++++++++++++++++++++++++++++ lib/ocaml/test.sh | 16 ++++++++++++++++ plans/ocaml-on-sx.md | 11 +++++++++-- 4 files changed, 62 insertions(+), 2 deletions(-) diff --git a/lib/ocaml/eval.sx b/lib/ocaml/eval.sx index ff7c8c08..72e22faa 100644 --- a/lib/ocaml/eval.sx +++ b/lib/ocaml/eval.sx @@ -633,6 +633,7 @@ (set! env (ocaml-env-extend env mname mod-val)) (set! result (merge result (dict mname mod-val)))))))) ((= tag "type-def") nil) + ((= tag "exception-def") nil) ((= tag "open") (let ((mod-val (ocaml-resolve-module-path (nth decl 1) env))) (cond @@ -809,6 +810,10 @@ ;; are dispatched by tag at eval/match time. Phase 5 ;; HM extensions will register ctor types here. nil) + ((= tag "exception-def") + ;; exception E [of T] — purely declarative; raise+match + ;; already work on tagged ctor values. + nil) ((or (= tag "open") (= tag "include")) ;; open M / include M — bring M's bindings into scope. (let ((mod-val (ocaml-resolve-module-path (nth decl 1) env))) diff --git a/lib/ocaml/parser.sx b/lib/ocaml/parser.sx index cffa971a..dd7f59a0 100644 --- a/lib/ocaml/parser.sx +++ b/lib/ocaml/parser.sx @@ -909,6 +909,7 @@ ((at-kw? "include") nil) ((at-kw? "and") nil) ((at-kw? "type") nil) + ((at-kw? "exception") nil) (else (begin (advance-tok!) (skip-to-boundary!)))))) (define parse-decl-let @@ -978,6 +979,35 @@ ;; module M = struct DECLS end ;; Parsed by sub-tokenising the body source between `struct` and ;; the matching `end`. Nested modules / sigs increment depth. + ;; exception NAME [of TYPE [* TYPE]*] + (define + parse-decl-exception + (fn () + (advance-tok!) ;; consume 'exception' + (let ((name (ocaml-tok-value (consume! "ctor" nil))) + (arg-srcs (list))) + (begin + (when (at-kw? "of") + (begin + (advance-tok!) + (let ((arg-start (cur-pos))) + (begin + (define skip-type + (fn () + (cond + ((>= idx tok-len) nil) + ((= (ocaml-tok-type (peek-tok)) "eof") nil) + ((at-op? ";;") nil) + ((at-kw? "let") nil) + ((at-kw? "type") nil) + ((at-kw? "and") nil) + ((at-kw? "module") nil) + ((at-kw? "exception") nil) + (else (begin (advance-tok!) (skip-type)))))) + (skip-type) + (append! arg-srcs (slice src arg-start (cur-pos))))))) + (cons :exception-def (cons name arg-srcs)))))) + ;; type [PARAMS] NAME = | Ctor [of T1 [* T2]*] | … ;; ;; PARAMS is `'a` or `('a, 'b)` (single or paren-tuple of tyvars). @@ -1217,6 +1247,8 @@ (begin (append! decls (parse-decl-open true)) (loop))) ((at-kw? "type") (begin (append! decls (parse-decl-type)) (loop))) + ((at-kw? "exception") + (begin (append! decls (parse-decl-exception)) (loop))) (else (begin (append! decls (parse-decl-expr)) (loop)))))))) (loop) (cons :program decls))))) diff --git a/lib/ocaml/test.sh b/lib/ocaml/test.sh index ff6f2049..29ba8e52 100755 --- a/lib/ocaml/test.sh +++ b/lib/ocaml/test.sh @@ -754,6 +754,16 @@ cat > "$TMPFILE" << 'EPOCHS' (epoch 1304) (eval "(ocaml-run-program \"type shape = Circle of int | Square of int ;; match Circle 5 with | Circle r -> r | Square s -> s\")") +;; ── exception declarations ──────────────────────────────────── +(epoch 1320) +(eval "(ocaml-parse-program \"exception MyExn\")") +(epoch 1321) +(eval "(ocaml-parse-program \"exception MyExn of int\")") +(epoch 1322) +(eval "(ocaml-run-program \"exception E of int ;; try raise (E 5) with | E n -> n\")") +(epoch 1323) +(eval "(ocaml-run-program \"exception E of string ;; try raise (E \\\"oops\\\") with | E s -> s\")") + EPOCHS OUTPUT=$(timeout 180 "$SX_SERVER" < "$TMPFILE" 2>/dev/null) @@ -1194,6 +1204,12 @@ check 1302 "type-decl + match Red" '1' check 1303 "type-decl + match Blue" '3' check 1304 "type-decl + Circle r" '5' +# ── exception declarations ───────────────────────────────────── +check 1320 "exception nullary" '("exception-def" "MyExn")' +check 1321 "exception arg" '("exception-def" "MyExn"' +check 1322 "raise+catch with arg" '5' +check 1323 "raise+catch string arg" '"oops"' + 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 04658512..417d34f7 100644 --- a/plans/ocaml-on-sx.md +++ b/plans/ocaml-on-sx.md @@ -178,8 +178,10 @@ SX CEK evaluator (both JS and OCaml hosts) - [x] Exhaustiveness: runtime error on incomplete match (no compile-time check yet). - [ ] Built-in types: `option` (`None`/`Some`), `result` (`Ok`/`Error`), `list` (nil/cons), `bool`, `unit`, `exn`. -- [ ] `exception` declarations; built-in: `Not_found`, `Invalid_argument`, - `Failure`, `Match_failure`. +- [x] `exception` declarations: `exception NAME [of TYPE]`. Parser emits + `(:exception-def NAME [ARG-TYPE-SRC])`. Runtime no-op since + raise/match work on tagged ctor values. Built-ins: + `Failure`/`Invalid_argument` via `failwith`/`invalid_arg`. - [ ] Polymorphic variants (surface syntax `\`Tag value`; runtime same tagged list). - [ ] Tests in `lib/ocaml/tests/adt.sx` — 40+ tests: ADTs, match, option/result. @@ -358,6 +360,11 @@ the "mother tongue" closure: OCaml → SX → OCaml. This means: _Newest first._ +- 2026-05-08 Phase 3 — `exception` declarations (+4 tests, 304 total). + `exception NAME [of TYPE]` parses to `(:exception-def NAME [ARG-SRC])`. + Runtime is a no-op: exception values are just tagged ctor values, so + the existing `raise`/`try`/`with` machinery works without any extra + wiring. - 2026-05-08 Phase 3 — `type` declarations (+5 tests, 300 total). Parser handles `type [PARAMS] NAME = | Ctor [of T1 [* T2]*] | ...`, with optional `'a` or `('a, 'b)` type parameters. Argument types are