From d8f6250962c01a0d0ab942212f58d24e3ac68d11 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 12:32:39 +0000 Subject: [PATCH] ocaml: phase 3 type declarations (+5 tests, 300 total) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Parser: type [PARAMS] NAME = | Ctor [of T1 [* T2]*] | ... - PARAMS: optional 'a or ('a, 'b) tyvar list - AST: (:type-def NAME PARAMS CTORS) with each CTOR (NAME ARG-SOURCES) - Argument types captured as raw source strings (treated opaquely at runtime since ctor dispatch is dynamic) Runtime is a no-op — constructors and pattern matching already work dynamically. Phase 5 will use these decls to register ctor types for HM checking. --- lib/ocaml/eval.sx | 6 ++++ lib/ocaml/parser.sx | 74 ++++++++++++++++++++++++++++++++++++++++++++ lib/ocaml/test.sh | 19 ++++++++++++ plans/ocaml-on-sx.md | 14 +++++++-- 4 files changed, 110 insertions(+), 3 deletions(-) diff --git a/lib/ocaml/eval.sx b/lib/ocaml/eval.sx index fec7cd8b..ff7c8c08 100644 --- a/lib/ocaml/eval.sx +++ b/lib/ocaml/eval.sx @@ -632,6 +632,7 @@ (begin (set! env (ocaml-env-extend env mname mod-val)) (set! result (merge result (dict mname mod-val)))))))) + ((= tag "type-def") nil) ((= tag "open") (let ((mod-val (ocaml-resolve-module-path (nth decl 1) env))) (cond @@ -803,6 +804,11 @@ (begin (set! env (ocaml-env-extend env mname mod-val)) (set! last mod-val)))))) + ((= tag "type-def") + ;; type t = ... — purely declarative at runtime; ctors + ;; are dispatched by tag at eval/match time. Phase 5 + ;; HM extensions will register ctor types here. + 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 dd5a24a7..cffa971a 100644 --- a/lib/ocaml/parser.sx +++ b/lib/ocaml/parser.sx @@ -908,6 +908,7 @@ ((at-kw? "open") nil) ((at-kw? "include") nil) ((at-kw? "and") nil) + ((at-kw? "type") nil) (else (begin (advance-tok!) (skip-to-boundary!)))))) (define parse-decl-let @@ -977,6 +978,77 @@ ;; module M = struct DECLS end ;; Parsed by sub-tokenising the body source between `struct` and ;; the matching `end`. Nested modules / sigs increment depth. + ;; type [PARAMS] NAME = | Ctor [of T1 [* T2]*] | … + ;; + ;; PARAMS is `'a` or `('a, 'b)` (single or paren-tuple of tyvars). + ;; We parse the structure and emit `(:type-def NAME PARAMS CTORS)` + ;; where each CTOR is `(NAME ARG-TYPES)` (ARG-TYPES list of source + ;; strings — types are treated opaquely at runtime). + (define + parse-decl-type + (fn () + (advance-tok!) ;; consume 'type' + (let ((tparams (list))) + (begin + ;; Optional type-vars before the type name. + (cond + ((= (ocaml-tok-type (peek-tok)) "tyvar") + (begin + (append! tparams (ocaml-tok-value (peek-tok))) + (advance-tok!))) + ((at-op? "(") + (begin + (advance-tok!) + (define more + (fn () + (when (= (ocaml-tok-type (peek-tok)) "tyvar") + (begin + (append! tparams (ocaml-tok-value (peek-tok))) + (advance-tok!) + (when (at-op? ",") + (begin (advance-tok!) (more))))))) + (more) + (consume! "op" ")")))) + (let ((name (ocaml-tok-value (consume! "ident" nil)))) + (begin + (consume! "op" "=") + (when (at-op? "|") (advance-tok!)) + ;; Parse a sum-type: Ctor [of TYPE [* TYPE]*] (| Ctor …)* + (let ((ctors (list))) + (begin + (define one + (fn () + (let ((cname (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-op? ";;") nil) + ((at-kw? "let") nil) + ((at-kw? "type") nil) + ((at-kw? "and") nil) + ((at-kw? "module") nil) + (else (begin (advance-tok!) (skip-type)))))) + (skip-type) + (append! arg-srcs (slice src arg-start (cur-pos))))))) + (append! ctors (cons cname arg-srcs)))))) + (one) + (define more + (fn () + (when (at-op? "|") + (begin (advance-tok!) (one) (more))))) + (more) + (list :type-def name tparams ctors))))))))) + ;; open M / include M — collect a path Ctor(.SubCtor)* and emit ;; (:open PATH) or (:include PATH). (define @@ -1143,6 +1215,8 @@ (begin (append! decls (parse-decl-open false)) (loop))) ((at-kw? "include") (begin (append! decls (parse-decl-open true)) (loop))) + ((at-kw? "type") + (begin (append! decls (parse-decl-type)) (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 776cd7b1..ff6f2049 100755 --- a/lib/ocaml/test.sh +++ b/lib/ocaml/test.sh @@ -742,6 +742,18 @@ cat > "$TMPFILE" << 'EPOCHS' (epoch 1205) (eval "(ocaml-run \"match (Some 3) with | None -> 0 | Some x when x > 5 -> x * 10 | Some x -> x\")") +;; ── type declarations (parser + runtime) ────────────────────── +(epoch 1300) +(eval "(ocaml-parse-program \"type color = Red | Green | Blue\")") +(epoch 1301) +(eval "(ocaml-parse-program \"type shape = Circle of int | Rect of int | Square of int\")") +(epoch 1302) +(eval "(ocaml-run-program \"type color = Red | Green | Blue ;; match Red with | Red -> 1 | Green -> 2 | Blue -> 3\")") +(epoch 1303) +(eval "(ocaml-run-program \"type color = Red | Green | Blue ;; match Blue with | Red -> 1 | Green -> 2 | Blue -> 3\")") +(epoch 1304) +(eval "(ocaml-run-program \"type shape = Circle of int | Square of int ;; match Circle 5 with | Circle r -> r | Square s -> s\")") + EPOCHS OUTPUT=$(timeout 180 "$SX_SERVER" < "$TMPFILE" 2>/dev/null) @@ -1175,6 +1187,13 @@ check 1203 "when sign 0" '0' check 1204 "when guard fires" '70' check 1205 "when guard skips" '3' +# ── type declarations ─────────────────────────────────────────── +check 1300 "type color enum" '("type-def" "color" () (("Red") ("Green") ("Blue")))' +check 1301 "type shape with-args" '("type-def" "shape"' +check 1302 "type-decl + match Red" '1' +check 1303 "type-decl + match Blue" '3' +check 1304 "type-decl + Circle r" '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 50630441..04658512 100644 --- a/plans/ocaml-on-sx.md +++ b/plans/ocaml-on-sx.md @@ -167,9 +167,10 @@ SX CEK evaluator (both JS and OCaml hosts) ### Phase 3 — ADTs + pattern matching -- [ ] `type` declarations: `type t = A | B of t1 * t2 | C of { x: int }`. - _(Parser + evaluator currently inferred-arity at runtime; type decls - pending.)_ +- [x] `type` declarations: `type [params] t = | A | B of t1 [* t2] | …`. + Parser emits `(:type-def NAME PARAMS CTORS)`. Runtime treats decls + as no-ops since constructors are dispatched dynamically by tag. + Phase 5 will register ctor types here for HM checking. - [x] Constructors as tagged lists: `A` → `("A")`, `B(1, "x")` → `("B" 1 "x")`. - [~] `match`/`with`: constructor, literal, variable, wildcard, tuple, list cons/nil, nested patterns. _(Pending: `as` binding, or-patterns, @@ -357,6 +358,13 @@ the "mother tongue" closure: OCaml → SX → OCaml. This means: _Newest first._ +- 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 + captured as raw source strings (treated opaquely at runtime). Runtime + is a no-op since ctor application + match already work dynamically. + 300th test! Constructors `Red`/`Green`/`Blue` and `Circle of int` / + `Square of int` round-trip through parse + eval cleanly. - 2026-05-08 Phase 3 — `as` aliases + `when` guards in match (+6 tests, 295 total). Parser: pattern parser wraps with `as ident` → `(:pas PAT NAME)`. Match's `one` consumes optional `when GUARD-EXPR` → emits