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