From e9c8f803b529112b849e4a20799962ba1cfb1d68 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 24 Apr 2026 21:45:51 +0000 Subject: [PATCH] haskell: runtime constructor registry (+24 tests, 250/250) --- lib/haskell/runtime.sx | 121 +++++++++++++++++++++++++++++++++ lib/haskell/test.sh | 2 + lib/haskell/tests/runtime.sx | 127 +++++++++++++++++++++++++++++++++++ plans/haskell-on-sx.md | 22 +++++- 4 files changed, 271 insertions(+), 1 deletion(-) create mode 100644 lib/haskell/runtime.sx create mode 100644 lib/haskell/tests/runtime.sx diff --git a/lib/haskell/runtime.sx b/lib/haskell/runtime.sx new file mode 100644 index 00000000..243d434d --- /dev/null +++ b/lib/haskell/runtime.sx @@ -0,0 +1,121 @@ +;; Haskell runtime: constructor registry. +;; +;; A mutable dict keyed by constructor name (e.g. "Just", "[]") with +;; entries of shape {:arity N :type TYPE-NAME-STRING}. +;; Populated by ingesting `data` / `newtype` decls from parsed ASTs. +;; Pre-registers a small set of constructors tied to Haskell syntactic +;; forms (Bool, list, unit) — every nontrivial program depends on +;; these, and the parser/desugar pipeline emits them as (:var "True") +;; etc. without a corresponding `data` decl. + +(define hk-constructors (dict)) + +(define + hk-register-con! + (fn + (cname arity type-name) + (dict-set! + hk-constructors + cname + {:arity arity :type type-name}))) + +(define hk-is-con? (fn (name) (has-key? hk-constructors name))) + +(define + hk-con-arity + (fn + (name) + (if + (has-key? hk-constructors name) + (get (get hk-constructors name) "arity") + nil))) + +(define + hk-con-type + (fn + (name) + (if + (has-key? hk-constructors name) + (get (get hk-constructors name) "type") + nil))) + +(define hk-con-names (fn () (keys hk-constructors))) + +;; ── Registration from AST ──────────────────────────────────── +;; (:data NAME TVARS ((:con-def CNAME FIELDS) …)) +(define + hk-register-data! + (fn + (data-node) + (let + ((type-name (nth data-node 1)) + (cons-list (nth data-node 3))) + (for-each + (fn + (cd) + (hk-register-con! + (nth cd 1) + (len (nth cd 2)) + type-name)) + cons-list)))) + +;; (:newtype NAME TVARS CNAME FIELD) +(define + hk-register-newtype! + (fn + (nt-node) + (hk-register-con! + (nth nt-node 3) + 1 + (nth nt-node 1)))) + +;; Walk a decls list, registering every `data` / `newtype` decl. +(define + hk-register-decls! + (fn + (decls) + (for-each + (fn + (d) + (cond + ((and + (list? d) + (not (empty? d)) + (= (first d) "data")) + (hk-register-data! d)) + ((and + (list? d) + (not (empty? d)) + (= (first d) "newtype")) + (hk-register-newtype! d)) + (:else nil))) + decls))) + +(define + hk-register-program! + (fn + (ast) + (cond + ((nil? ast) nil) + ((not (list? ast)) nil) + ((empty? ast) nil) + ((= (first ast) "program") + (hk-register-decls! (nth ast 1))) + ((= (first ast) "module") + (hk-register-decls! (nth ast 4))) + (:else nil)))) + +;; Convenience: source → AST → desugar → register. +(define + hk-load-source! + (fn (src) (hk-register-program! (hk-core src)))) + +;; ── Built-in constructors pre-registered ───────────────────── +;; Bool — used implicitly by `if`, comparison operators. +(hk-register-con! "True" 0 "Bool") +(hk-register-con! "False" 0 "Bool") +;; List — used by list literals, range syntax, and cons operator. +(hk-register-con! "[]" 0 "List") +(hk-register-con! ":" 2 "List") +;; Unit — produced by empty parens `()`. +(hk-register-con! "()" 0 "Unit") diff --git a/lib/haskell/test.sh b/lib/haskell/test.sh index 031880f8..00e965b2 100755 --- a/lib/haskell/test.sh +++ b/lib/haskell/test.sh @@ -49,6 +49,7 @@ for FILE in "${FILES[@]}"; do (load "lib/haskell/layout.sx") (load "lib/haskell/parser.sx") (load "lib/haskell/desugar.sx") +(load "lib/haskell/runtime.sx") (load "lib/haskell/testlib.sx") (epoch 2) (load "$FILE") @@ -88,6 +89,7 @@ EPOCHS (load "lib/haskell/layout.sx") (load "lib/haskell/parser.sx") (load "lib/haskell/desugar.sx") +(load "lib/haskell/runtime.sx") (load "lib/haskell/testlib.sx") (epoch 2) (load "$FILE") diff --git a/lib/haskell/tests/runtime.sx b/lib/haskell/tests/runtime.sx new file mode 100644 index 00000000..45e306f7 --- /dev/null +++ b/lib/haskell/tests/runtime.sx @@ -0,0 +1,127 @@ +;; Runtime constructor-registry tests. Built-ins are pre-registered +;; when lib/haskell/runtime.sx loads; user types are registered by +;; walking a parsed+desugared AST with hk-register-program! (or the +;; `hk-load-source!` convenience). + +;; ── Pre-registered built-ins ── +(hk-test "True is a con" (hk-is-con? "True") true) +(hk-test "False is a con" (hk-is-con? "False") true) +(hk-test "[] is a con" (hk-is-con? "[]") true) +(hk-test ": (cons) is a con" (hk-is-con? ":") true) +(hk-test "() is a con" (hk-is-con? "()") true) + +(hk-test "True arity 0" (hk-con-arity "True") 0) +(hk-test ": arity 2" (hk-con-arity ":") 2) +(hk-test "[] arity 0" (hk-con-arity "[]") 0) +(hk-test "True type Bool" (hk-con-type "True") "Bool") +(hk-test "False type Bool" (hk-con-type "False") "Bool") +(hk-test ": type List" (hk-con-type ":") "List") +(hk-test "() type Unit" (hk-con-type "()") "Unit") + +;; ── Unknown names ── +(hk-test "is-con? false for varid" (hk-is-con? "foo") false) +(hk-test "arity nil for unknown" (hk-con-arity "NotACon") nil) +(hk-test "type nil for unknown" (hk-con-type "NotACon") nil) + +;; ── data MyBool = Yes | No ── +(hk-test + "register simple data" + (do + (hk-load-source! "data MyBool = Yes | No") + (list + (hk-con-arity "Yes") + (hk-con-arity "No") + (hk-con-type "Yes") + (hk-con-type "No"))) + (list 0 0 "MyBool" "MyBool")) + +;; ── data Maybe a = Nothing | Just a ── +(hk-test + "register Maybe" + (do + (hk-load-source! "data Maybe a = Nothing | Just a") + (list + (hk-con-arity "Nothing") + (hk-con-arity "Just") + (hk-con-type "Nothing") + (hk-con-type "Just"))) + (list 0 1 "Maybe" "Maybe")) + +;; ── data Either a b = Left a | Right b ── +(hk-test + "register Either" + (do + (hk-load-source! "data Either a b = Left a | Right b") + (list + (hk-con-arity "Left") + (hk-con-arity "Right") + (hk-con-type "Left") + (hk-con-type "Right"))) + (list 1 1 "Either" "Either")) + +;; ── Recursive data ── +(hk-test + "register recursive Tree" + (do + (hk-load-source! + "data Tree a = Leaf | Node (Tree a) a (Tree a)") + (list + (hk-con-arity "Leaf") + (hk-con-arity "Node") + (hk-con-type "Leaf") + (hk-con-type "Node"))) + (list 0 3 "Tree" "Tree")) + +;; ── newtype ── +(hk-test + "register newtype" + (do + (hk-load-source! "newtype Age = MkAge Int") + (list + (hk-con-arity "MkAge") + (hk-con-type "MkAge"))) + (list 1 "Age")) + +;; ── Multiple data decls in one program ── +(hk-test + "multiple data decls" + (do + (hk-load-source! + "data Color = Red | Green | Blue\ndata Shape = Circle | Square\nf x = x") + (list + (hk-con-type "Red") + (hk-con-type "Green") + (hk-con-type "Blue") + (hk-con-type "Circle") + (hk-con-type "Square"))) + (list "Color" "Color" "Color" "Shape" "Shape")) + +;; ── Inside a module header ── +(hk-test + "register from module body" + (do + (hk-load-source! + "module M where\ndata Pair a = Pair a a") + (list + (hk-con-arity "Pair") + (hk-con-type "Pair"))) + (list 2 "Pair")) + +;; ── Non-data decls are ignored ── +(hk-test + "program with only fun-decl leaves registry unchanged for that name" + (do + (hk-load-source! "myFunctionNotACon x = x + 1") + (hk-is-con? "myFunctionNotACon")) + false) + +;; ── Re-registering overwrites (last wins) ── +(hk-test + "re-registration overwrites the entry" + (do + (hk-load-source! "data Foo = Bar Int") + (hk-load-source! "data Foo = Bar Int Int") + (hk-con-arity "Bar")) + 2) + +{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail} diff --git a/plans/haskell-on-sx.md b/plans/haskell-on-sx.md index f8f729aa..b77e6b69 100644 --- a/plans/haskell-on-sx.md +++ b/plans/haskell-on-sx.md @@ -69,7 +69,7 @@ Key mappings: ### Phase 2 — desugar + eager-ish eval + ADTs (untyped) - [x] Desugar: guards → nested `if`s; `where` → `let`; list comp → `concatMap`-based; do-notation stays for now (desugared in phase 3) -- [ ] `data` declarations register constructors in runtime +- [x] `data` declarations register constructors in runtime - [ ] Pattern match (tag-based, value-level): atoms, vars, wildcards, constructor patterns, `as` patterns, nested - [ ] Evaluator (still strict internally — laziness in phase 3): `let`, `lambda`, application, `case`, literals, constructors - [ ] 30+ eval tests in `lib/haskell/tests/eval.sx` @@ -114,6 +114,26 @@ Key mappings: _Newest first._ +- **2026-04-24** — Phase 2: runtime constructor registry + (`lib/haskell/runtime.sx`). A mutable dict `hk-constructors` keyed + by constructor name, each entry carrying arity and owning type. + `hk-register-data!` walks a `:data` AST and registers every + `:con-def` with its arity (= number of field types) and the type + name; `hk-register-newtype!` does the one-constructor variant; + `hk-register-decls!` / `hk-register-program!` filter a decls list + (or a `:program` / `:module` AST) and call the appropriate + registrar. `hk-load-source!` composes it with `hk-core` + (tokenize → layout → parse → desugar → register). Pre-registers + five built-ins tied to Haskell syntactic forms: `True` / `False` + (Bool), `[]` and `:` (List), `()` (Unit) — everything else comes + from user declarations or the eventual Prelude. Query helpers: + `hk-is-con?`, `hk-con-arity`, `hk-con-type`, `hk-con-names`. 24 + new tests in `lib/haskell/tests/runtime.sx` cover each built-in + (arity + type), unknown-name probes, registration of `MyBool` / + `Maybe` / `Either` / recursive `Tree` / `newtype Age`, multi-data + programs, a module-header body, ignoring non-data decls, and + last-wins re-registration. 250/250 green. + - **2026-04-24** — Phase 2 kicks off with `lib/haskell/desugar.sx` — a tree-walking rewriter that eliminates the three surface-only forms produced by the parser, leaving a smaller core AST for the evaluator: