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

28
host/chez/collections.ss
View file

@ -225,16 +225,28 @@
(fold-left jolt-conj1 jolt-empty-list xs)
(fold-left jolt-conj1 coll xs)))))
;; A host shim registers a type's get via register-get-arm! (handler: (coll k d) ->
;; value) instead of set!-wrapping jolt-get — disjoint coll types, checked before the
;; base map/set/vec/string cases (cf. register-hash-arm!).
(define jolt-get-arms '())
(define (register-get-arm! pred handler)
(set! jolt-get-arms (cons (cons pred handler) jolt-get-arms)))
(define (jolt-get-base coll k d)
(cond ((pmap? coll) (pmap-get coll k d))
((pset? coll) (if (pset-contains? coll k) k d))
((pvec? coll) (pvec-nth-d coll k d))
((string? coll) (let ((i (->idx k)))
(if (and (fixnum? i) (fx>=? i 0) (fx<? i (string-length coll))) (string-ref coll i) d)))
(else d)))
(define (jolt-get-dispatch coll k d)
(let loop ((as jolt-get-arms))
(cond ((null? as) (jolt-get-base coll k d))
(((caar as) coll) ((cdar as) coll k d))
(else (loop (cdr as))))))
(define jolt-get
(case-lambda
((coll k) (jolt-get coll k jolt-nil))
((coll k d)
(cond ((pmap? coll) (pmap-get coll k d))
((pset? coll) (if (pset-contains? coll k) k d))
((pvec? coll) (pvec-nth-d coll k d))
((string? coll) (let ((i (->idx k)))
(if (and (fixnum? i) (fx>=? i 0) (fx<? i (string-length coll))) (string-ref coll i) d)))
(else d)))))
((coll k) (jolt-get-dispatch coll k jolt-nil))
((coll k d) (jolt-get-dispatch coll k d))))
(define jolt-nth
(case-lambda