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

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.

host/chez/bigdec.ss

@@ -68,8 +68,7 @@
         (else (%bd-jolt=2 a b)))))
 
 ;; str drops the M; pr/pr-str keep it.
-(define %bd-str-render jolt-str-render-one)
+(register-str-render! jbigdec? jbigdec->string)
-(set! jolt-str-render-one (lambda (x) (if (jbigdec? x) (jbigdec->string x) (%bd-str-render x))))
 (define %bd-pr-str jolt-pr-str)
 (set! jolt-pr-str (lambda (x) (if (jbigdec? x) (string-append (jbigdec->string x) "M") (%bd-pr-str x))))
 (define %bd-pr-readable jolt-pr-readable)

host/chez/converters.ss

@@ -3,8 +3,19 @@
 ;; the printer. int/long truncate toward zero to an exact integer; compare returns
 ;; an exact -1/0/1; double yields a flonum.
 
-;; str: nil -> "", string raw, char bare (not \c), regex -> raw source, else the
+;; str rendering for the value types not handled by the fast arms below. A host
-;; printer (which renders collections with readable elements).
+;; shim loaded later (records, host-table, inst-time, …) registers an arm with
+;; register-str-render! instead of set!-wrapping jolt-str-render-one — the arms
+;; are type-disjoint, so the full behavior is the base arms here plus the
+;; registry, gathered in one place rather than scattered across a set! chain.
+;; Newest registration is checked first (matches the old outermost-wins order).
+(define str-render-registry '())   ; list of (pred . render), checked front-to-back
+(define (register-str-render! pred render)
+  (set! str-render-registry (cons (cons pred render) str-render-registry)))
+
+;; str: nil -> "", string raw, char bare (not \c), regex -> raw source, a
+;; registered host type via its arm, else the printer (which renders collections
+;; with readable elements).
 (define (jolt-str-render-one v)
   (cond
     ((jolt-nil? v) "")
@@ -16,7 +27,12 @@
     ((and (flonum? v) (fl= v +inf.0)) "Infinity")
     ((and (flonum? v) (fl= v -inf.0)) "-Infinity")
     ((and (flonum? v) (not (fl= v v))) "NaN")
-    (else (jolt-pr-str v))))
+    (else
+     (let loop ((rs str-render-registry))
+       (cond
+         ((null? rs) (jolt-pr-str v))
+         (((caar rs) v) ((cdar rs) v))
+         (else (loop (cdr rs))))))))
 (define (jolt-str . xs)
   (let loop ((xs xs) (acc '()))
     (if (null? xs)

host/chez/host-static-objects.ss

@@ -487,16 +487,14 @@
 ;; Pluggable instance? — a library registers (fn [class-name-string val] -> true
 ;; | false | nil); nil means "not my class, fall through". First non-nil wins.
 (define user-instance-checks '())
-(define %hs-instance-check instance-check)
+(register-instance-check-arm!
-(set! instance-check
   (lambda (type-sym val)
     (let ((tname (symbol-t-name type-sym)))
       (let loop ((fs user-instance-checks))
         (if (null? fs)
-            (%hs-instance-check type-sym val)
+            'pass
             (let ((r ((car fs) tname val)))
               (if (jolt-nil? r) (loop (cdr fs)) (if (jolt-truthy? r) #t #f))))))))
-(def-var! "clojure.core" "instance-check" instance-check)
 (def-var! "clojure.core" "__register-instance-check!"
   (lambda (f) (set! user-instance-checks (append user-instance-checks (list f))) jolt-nil))
 

host/chez/host-table.ss

@@ -160,8 +160,7 @@
 (set! jolt-pr-readable (lambda (x) (if (htable-sorted? x) (sorted-render x jolt-pr-readable) (%h-pr-readable x))))
 (define %h-pr-str jolt-pr-str)
 (set! jolt-pr-str (lambda (x) (if (htable-sorted? x) (sorted-render x jolt-pr-str) (%h-pr-str x))))
-(define %h-str-render-one jolt-str-render-one)
+(register-str-render! htable-sorted? (lambda (x) (sorted-render x jolt-str-render-one)))
-(set! jolt-str-render-one (lambda (x) (if (htable-sorted? x) (sorted-render x jolt-str-render-one) (%h-str-render-one x))))
 
 ;; --- protocol dispatch over builtins (extend-protocol Map/Set on sorted) ------
 ;; value-host-tags (records.ss) drives extend-protocol on host values; a

host/chez/inst-time.ss

@@ -255,8 +255,7 @@
 (set! jolt-pr-str (lambda (x) (if (jinst? x) (inst-pr x) (%it-pr-str x))))
 (define %it-pr-readable jolt-pr-readable)
 (set! jolt-pr-readable (lambda (x) (if (jinst? x) (inst-pr x) (%it-pr-readable x))))
-(define %it-str-render jolt-str-render-one)
+(register-str-render! jinst? inst-rfc3339)
-(set! jolt-str-render-one (lambda (x) (if (jinst? x) (inst-rfc3339 x) (%it-str-render x))))
 
 (define %it-type jolt-type)
 (set! jolt-type (lambda (x) (if (jinst? x) inst-type-kw (%it-type x))))
@@ -266,8 +265,7 @@
 ;; matching jhost tag. The instance? macro passes the class-name symbol.
 (define (class-short tn) (let loop ((i (- (string-length tn) 1)))
                            (cond ((< i 0) tn) ((char=? (string-ref tn i) #\.) (substring tn (+ i 1) (string-length tn))) (else (loop (- i 1))))))
-(define %it-instance-check instance-check)
+(register-instance-check-arm!
-(set! instance-check
   (lambda (type-sym val)
     (let ((tn (class-short (symbol-t-name type-sym))))
       (cond
@@ -275,11 +273,10 @@
         ;; (on the JVM a Date is not a Timestamp), so answer Timestamp explicitly #f.
         ((jinst? val) (cond ((string=? tn "Date") #t)
                             ((string=? tn "Timestamp") #f)
-                            (else (%it-instance-check type-sym val))))
+                            (else 'pass)))
-        ((and (jhost? val) (string=? (jhost-tag val) "instant")) (if (string=? tn "Instant") #t (%it-instance-check type-sym val)))
+        ((and (jhost? val) (string=? (jhost-tag val) "instant")) (if (string=? tn "Instant") #t 'pass))
-        ((and (jhost? val) (string=? (jhost-tag val) "local-dt")) (if (string=? tn "LocalDateTime") #t (%it-instance-check type-sym val)))
+        ((and (jhost? val) (string=? (jhost-tag val) "local-dt")) (if (string=? tn "LocalDateTime") #t 'pass))
-        (else (%it-instance-check type-sym val))))))
+        (else 'pass)))))
-(def-var! "clojure.core" "instance-check" instance-check)
 
 ;; inst-ms* is a seed native (the overlay inst-ms reads (get x :ms), now answered).
 (def-var! "clojure.core" "inst-ms*" (lambda (i) (jinst-ms i)))

host/chez/io.ss

@@ -221,9 +221,7 @@
 
 ;; --- str / type / instance? integration ------------------------------------
 ;; str of a jfile is its path (Clojure's File.toString).
-(define %io-str-render jolt-str-render-one)
+(register-str-render! jfile? jfile-path)
-(set! jolt-str-render-one
-  (lambda (v) (if (jfile? v) (jfile-path v) (%io-str-render v))))
 
 ;; stdin line seam: the clojure.core *in* reader (50-io.clj) drives read-line /
 ;; read / read+string through __stdin-read-line. Return the next line (newline
@@ -241,16 +239,14 @@
 
 ;; (instance? java.io.File f): the instance? macro passes the class-name symbol;
 ;; match "File" / "java.io.File" (and any *.File) against a jfile.
-(define %io-instance-check instance-check)
+(register-instance-check-arm!
-(set! instance-check
   (lambda (type-sym val)
     (let ((tname (symbol-t-name type-sym)))
       (if (and (jfile? val)
                (or (string=? tname "File") (string=? tname "java.io.File")
                    (string=? (path-last-segment tname) "File")))
           #t
-          (%io-instance-check type-sym val)))))
+          'pass))))
-(def-var! "clojure.core" "instance-check" instance-check)
 
 ;; --- def-var! the native names the overlay file-seq + str/slurp use ----
 (def-var! "clojure.core" "__make-file" jolt-make-file)
@@ -475,9 +471,8 @@
         (cons "equals" (lambda (u o) (and (jhost? o) (string=? (jhost-tag o) "uri")
                                           (string=? (uri-field u 'string) (uri-field o 'string)))))))
 ;; str / pr-str of a uri -> its string form.
-(define %uri-str-render-one jolt-str-render-one)
+(register-str-render! (lambda (x) (and (jhost? x) (string=? (jhost-tag x) "uri")))
-(set! jolt-str-render-one
+                      (lambda (x) (uri-field x 'string)))
-  (lambda (x) (if (and (jhost? x) (string=? (jhost-tag x) "uri")) (uri-field x 'string) (%uri-str-render-one x))))
 (define %uri-pr-readable jolt-pr-readable)
 (set! jolt-pr-readable
   (lambda (x) (if (and (jhost? x) (string=? (jhost-tag x) "uri"))

host/chez/lazy-bridge.ss

@@ -69,8 +69,7 @@
 (set! jolt-pr-str (lambda (x) (if (jolt-lazyseq? x) (%ls-pr-str (jolt-seq x)) (%ls-pr-str x))))
 (define %ls-pr-readable jolt-pr-readable)
 (set! jolt-pr-readable (lambda (x) (if (jolt-lazyseq? x) (%ls-pr-readable (jolt-seq x)) (%ls-pr-readable x))))
-(define %ls-str-render-one jolt-str-render-one)
+(register-str-render! jolt-lazyseq? (lambda (x) (jolt-str-render-one (jolt-seq x))))
-(set! jolt-str-render-one (lambda (x) (if (jolt-lazyseq? x) (%ls-str-render-one (jolt-seq x)) (%ls-str-render-one x))))
 
 ;; seq? — a lazy seq IS a seq (predicates.ss's jolt-seq? predates the lazyseq
 ;; record). Unlike the native-op dispatchers above (called via a direct top-level

host/chez/natives-array.ss

@@ -158,21 +158,18 @@
 (set! jolt-type (lambda (x) (if (jolt-array? x) (na-array-class-name x) (%na-type x))))
 (def-var! "clojure.core" "type" jolt-type)
 
-;; instance? over an array class token ([I, [C, …). The token reaches us as a
+;; instance? over an array class token ([I, [C, …). An array token reaches us as
-;; string (Class/forName "[C") or symbol; normalize, and pass a non-array string
+;; a string ("[C", from (Class/forName "[C")) — the dispatcher leaves it a string
-;; token on as a symbol so the inner wrappers' symbol-t-name doesn't choke.
+;; (non-array string tokens are already normalized to symbols there); decide it
-(define %na-instance-check instance-check)
+;; here, deferring everything else.
-(set! instance-check
+(register-instance-check-arm!
   (lambda (type-sym val)
     (let ((tname (cond ((string? type-sym) type-sym)
                        ((symbol-t? type-sym) (symbol-t-name type-sym))
                        (else #f))))
-      (cond
+      (if (and tname (> (string-length tname) 0) (char=? (string-ref tname 0) #\[))
-        ((and tname (> (string-length tname) 0) (char=? (string-ref tname 0) #\[))
+          (and (jolt-array? val) (string=? (na-array-class-name val) tname))
-         (and (jolt-array? val) (string=? (na-array-class-name val) tname)))
+          'pass))))
-        ((string? type-sym) (%na-instance-check (jolt-symbol #f type-sym) val))
-        (else (%na-instance-check type-sym val))))))
-(def-var! "clojure.core" "instance-check" instance-check)
 
 ;; clojure.java.io/reader over a char-array reads its chars (the JVM char[] branch).
 (def-var! "clojure.java.io" "reader"

host/chez/natives-misc.ss

@@ -51,8 +51,7 @@
 ;; the prelude would clobber a def-var! here — they're asserted in post-prelude.ss.
 
 ;; str of a uuid -> the bare 36-char string; pr-str -> #uuid "…".
-(define %m-str-render-one jolt-str-render-one)
+(register-str-render! juuid? juuid-s)
-(set! jolt-str-render-one (lambda (x) (if (juuid? x) (juuid-s x) (%m-str-render-one x))))
 (define (juuid-pr u) (string-append "#uuid \"" (juuid-s u) "\""))
 (define %m-pr-str jolt-pr-str)
 (set! jolt-pr-str (lambda (x) (if (juuid? x) (juuid-pr x) (%m-pr-str x))))

host/chez/natives-queue.ss

@@ -46,15 +46,13 @@
 (define (jolt-seq-or-empty x) (let ((s (jolt-seq x))) (if (jolt-nil? s) jolt-empty-list s)))
 (define %q-pr-readable jolt-pr-readable)
 (set! jolt-pr-readable (lambda (x) (if (jolt-queue? x) (%q-pr-readable (jolt-seq-or-empty x)) (%q-pr-readable x))))
-(define %q-str-render-one jolt-str-render-one)
+(register-str-render! jolt-queue? (lambda (x) (jolt-str-render-one (jolt-seq-or-empty x))))
-(set! jolt-str-render-one (lambda (x) (if (jolt-queue? x) (%q-str-render-one (jolt-seq-or-empty x)) (%q-str-render-one x))))
 
 ;; class / type / instance? recognize a queue.
 (define %q-class jolt-class)
 (set! jolt-class (lambda (x) (if (jolt-queue? x) "clojure.lang.PersistentQueue" (%q-class x))))
 (def-var! "clojure.core" "class" jolt-class)
-(define %q-instance-check instance-check)
+(register-instance-check-arm!
-(set! instance-check
   (lambda (type-sym val)
     (if (jolt-queue? val)
         (let ((tn (cond ((string? type-sym) type-sym)
@@ -62,8 +60,7 @@
           (and (member (last-dot tn)
                        '("PersistentQueue" "IPersistentCollection" "Sequential" "Collection" "Object"))
                #t))
-        (%q-instance-check type-sym val))))
+        'pass)))
-(def-var! "clojure.core" "instance-check" instance-check)
 
 ;; clojure.lang.PersistentQueue/EMPTY + a queue? predicate.
 (register-class-statics! "PersistentQueue" (list (cons "EMPTY" jolt-queue-empty)))

host/chez/ns.ss

@@ -348,5 +348,4 @@
 (set! jolt-pr-str (lambda (x) (if (jns? x) (jns-name x) (%ns-pr-str x))))
 (define %ns-pr-readable jolt-pr-readable)
 (set! jolt-pr-readable (lambda (x) (if (jns? x) (jns-name x) (%ns-pr-readable x))))
-(define %ns-str-render-one jolt-str-render-one)
+(register-str-render! jns? jns-name)
-(set! jolt-str-render-one (lambda (x) (if (jns? x) (jns-name x) (%ns-str-render-one x))))

host/chez/records-interop.ss

@@ -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.
+;; instance-check: (type-sym val) — type/protocol membership. Host shims loaded
-(define (instance-check type-sym val)
+;; 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))

host/chez/records.ss

@@ -410,14 +410,11 @@
 ;; jolt exception values (ex-info + host-constructed throwables) are ex-info-shaped
 ;; maps tagged :jolt/type :jolt/ex-info; (class …)/instance? read the JVM class off
 ;; the optional :jolt/class key, defaulting to clojure.lang.ExceptionInfo.
-(define %r-str-render-one jolt-str-render-one)
+(register-str-render! jrec?
-(set! jolt-str-render-one
   (lambda (v)
-    (if (jrec? v)
     (let ((f (find-protocol-method (jrec-tag v) "Object" "toString")))
       (if f (jolt-invoke f v)
-              (let ((s (jrec-pr v))) (substring s 1 (string-length s)))))
+          (let ((s (jrec-pr v))) (substring s 1 (string-length s)))))))
-        (%r-str-render-one v))))
 
 ;; `type` lives in natives-meta.ss: it needs jolt-meta for the :type
 ;; override and a total value->taxonomy mapping, so it sits with meta — a record

host/chez/vars.ss

@@ -45,8 +45,7 @@
 (set! jolt-pr-str (lambda (x) (if (var-cell? x) (var->str x) (%v-pr-str x))))
 (define %v-pr-readable jolt-pr-readable)
 (set! jolt-pr-readable (lambda (x) (if (var-cell? x) (var->str x) (%v-pr-readable x))))
-(define %v-str-render-one jolt-str-render-one)
+(register-str-render! var-cell? var->str)
-(set! jolt-str-render-one (lambda (x) (if (var-cell? x) (var->str x) (%v-str-render-one x))))
 
 ;; bound? — native (the overlay's (get v :root) is nil on a var-cell record).
 (define (jolt-var-bound-one? v) (and (var-cell? v) (not (eq? (var-cell-root v) jolt-unbound))))