haskell: runtime constructor registry (+24 tests, 250/250)

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")

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")

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}

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: