simon/jolt
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

refactor: registry pattern for jolt-get + jolt=2 (jolt-lmot)

Browse source 
jolt-get (4 sites: host-table/natives-misc/inst-time/records) and jolt=2 (6 sites:
records/vars/inst-time/natives-misc/bigdec/host-table) move off the set!-rebind
chains to register-get-arm! / register-eq-arm!. get's case-lambda becomes a stable
2/3-arg entry over a 3-arg dispatch; the equality arm pred is (a b) since either arg
may carry the type, and the host-table sorted arm normalizes-then-re-dispatches.

Behaviour-preserving (runtime .ss): var/inst/bigdec/record/uuid equality, record!=map,
sorted-map=plain-map, and all the get cases verified; make test green, 0 new corpus
divergences. Four of six dispatchers done; the printer (pr-str/pr-readable) remains.
This commit is contained in:
Yogthos 2026-06-23 23:12:08 -04:00
parent d168d1195b
commit acf3e1ffd3
8 changed files with 63 additions and 65 deletions
Download patch file Download diff file Expand all files Collapse all files

11
host/chez/vars.ss
View file

@ -31,13 +31,10 @@
(if (var-cell? f) (apply jolt-invoke (var-cell-root f) args) (apply %v-invoke f args))))
;; two var cells are = iff same ns/name (Clojure var identity).
(define %v-=2 jolt=2)
(set! jolt=2 (lambda (a b)
(cond ((var-cell? a) (and (var-cell? b)
(string=? (var-cell-ns a) (var-cell-ns b))
(string=? (var-cell-name a) (var-cell-name b))))
((var-cell? b) #f)
(else (%v-=2 a b)))))
(register-eq-arm! (lambda (a b) (or (var-cell? a) (var-cell? b)))
(lambda (a b) (and (var-cell? a) (var-cell? b)
(string=? (var-cell-ns a) (var-cell-ns b))
(string=? (var-cell-name a) (var-cell-name b)))))
;; pr-str / str of a var -> #'ns/name.
(define (var->str v) (string-append "#'" (var-cell-ns v) "/" (var-cell-name v)))