giles
e9c8f803b5
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
122 lines
3.1 KiB
Plaintext
122 lines
3.1 KiB
Plaintext
;; 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")
|