;; 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")
;; Standard Prelude types — pre-registered so expression-level
;; programs can use them without a `data` decl.
(hk-register-con! "Nothing" 0 "Maybe")
(hk-register-con! "Just"    1 "Maybe")
(hk-register-con! "Left"    1 "Either")
(hk-register-con! "Right"   1 "Either")
(hk-register-con! "LT" 0 "Ordering")
(hk-register-con! "EQ" 0 "Ordering")
(hk-register-con! "GT" 0 "Ordering")