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

Replace str-render/instance-check set! chains with registries

Browse source 
jolt-str-render-one and instance-check were each extended by a chain of
set!-wrapping closures spread across ~10 and ~5 host files, so the real
behavior of either was scattered and load-order-dependent. Give each a
registry the base file owns: converters.ss/records-interop.ss define the
registry plus a register-* helper, and each extending file registers one arm
instead of capturing %prev and set!-ing the global.

str-render arms are type-disjoint; instance-check arms run newest-first (the
old outermost-wins order) and may return 'pass to defer. The string-token ->
symbol normalization the natives-array arm did for every inner arm moves to
the dispatcher head; array tokens stay strings for that arm to decide.

jolt-ogib.14. Runtime-only shims, no re-mint.
This commit is contained in:
Yogthos 2026-06-23 09:05:36 -04:00
parent bc16513afd
commit e434356590
14 changed files with 79 additions and 64 deletions
Download patch file Download diff file Expand all files Collapse all files

28
host/chez/records-interop.ss
View file

@ -49,8 +49,17 @@
((and (string=? c "ExceptionInfo") (string=? wanted "IExceptionInfo")) #t)
(else (let ((p (assoc c exception-parent))) (loop (and p (cdr p))))))))
;; instance-check: (type-sym val) — type/protocol membership.
(define (instance-check type-sym val)
;; instance-check: (type-sym val) — type/protocol membership. Host shims loaded
;; later (io, inst-time, natives-array, natives-queue, host-static-objects)
;; register an arm with register-instance-check-arm! instead of set!-wrapping
;; instance-check; an arm returns #t/#f to decide or 'pass to defer to the next.
;; Newest arm is checked first (matches the old outermost-wins set! order).
;; instance-check-base is the JVM taxonomy fallback when no arm decides.
(define instance-check-registry '())
(define (register-instance-check-arm! f) ; f: (type-sym val) -> #t | #f | 'pass
(set! instance-check-registry (cons f instance-check-registry)))
(define (instance-check-base type-sym val)
(let ((tname (symbol-t-name type-sym)))
(cond
((jrec? val)
@ -62,6 +71,21 @@
(and (memp (lambda (p) (string=? (last-dot p) short)) (jreify-protos val)) #t)))
((ex-info-map? val) (exception-isa? (last-dot (ex-info-class val)) (last-dot tname)))
(else (case-string tname val)))))
(define (instance-check type-sym val)
;; normalize a bare (non-array) string class token to a symbol so every arm and
;; the base table can read its name; array tokens ("[I") stay strings for the
;; natives-array arm.
(let ((ts (if (and (string? type-sym)
(or (= 0 (string-length type-sym))
(not (char=? (string-ref type-sym 0) #\[))))
(jolt-symbol #f type-sym)
type-sym)))
(let loop ((rs instance-check-registry))
(if (null? rs)
(instance-check-base ts val)
(let ((r ((car rs) ts val)))
(if (eq? r 'pass) (loop (cdr rs)) r))))))
(define (case-string tname val)
(cond
((member tname '("Number" "java.lang.Number")) (number? val))