Merge architecture-cleanup epic (jolt-ogib)

Dead code removal, O(n^2) hot-path fixes (transients/queues/deps), wiring the
optimization pass pipeline into compile + build, deterministic seed emission,
splitting the oversized files (20-coll, host-static, records, types lattice),
and restructuring the two worst maintainability smells: the str-render /
instance-check set!-override chains became registries, and the type-inference
walk now threads an immutable env instead of ~14 module atoms.

Adds an inference gate (make infer, 26 cases) so the type pass — which the
corpus/unit gates don't exercise — has real coverage. Full gate green:
self-host fixpoint holds, corpus 2735 (0 new divergences).

Makefile

@@ -4,7 +4,7 @@
 # build step. `make test` is the full gate. `make remint` rebuilds the seed after a
 # source change.
 
-.PHONY: test ci values corpus unit smoke buildsmoke selfhost sci certify ffi transient remint
+.PHONY: test ci values corpus unit smoke buildsmoke selfhost sci certify ffi transient infer remint
 
 # Full gate (dev machine). Includes the self-host byte-fixpoint, which only holds
 # on the same Chez that minted the seed.
@@ -15,7 +15,7 @@ test: selfhost ci
 # lockfile) — it RUNS correctly on any Chez, but `selfhost` rebuilds it and a
 # different Chez version may emit byte-different (gensym/order) output, so the
 # byte-fixpoint is a dev-machine check, not a CI one (jolt-8479).
-ci: values corpus unit smoke buildsmoke sci ffi transient certify
+ci: values corpus unit smoke buildsmoke sci ffi transient infer certify
 	@echo "OK: CI gates passed"
 
 # Self-host fixpoint: bootstrap.ss rebuild == checked-in seed.
@@ -55,6 +55,12 @@ ffi:
 transient:
 	@chez --script test/chez/transient-test.ss
 
+# Inference / success-type checking: drive jolt.passes.types directly and assert
+# diagnostic counts + collected calls/escapes (the optimization pass the other
+# gates don't exercise).
+infer:
+	@chez --script host/chez/run-infer.ss
+
 # JVM oracle: certify the corpus against reference Clojure. Skips if clojure absent.
 certify:
 	@if command -v clojure >/dev/null 2>&1; then \

ffi_smoke.clj

@@ -0,0 +1,13 @@
+(ns ffi-smoke
+  (:require [jolt.ffi :as ffi]))
+(ffi/load-library "libglib-2.0.dylib")
+(prn :sizeof-pointer (ffi/sizeof :pointer))
+(prn :null (ffi/null))
+(prn :null? (ffi/null? (ffi/null)))
+(ffi/defcfn g-get-monotonic-time "g_get_monotonic_time" [] :int64)
+(prn :monotonic-time (g-get-monotonic-time))
+(let [p (ffi/alloc 16)]
+  (ffi/write p :int64 0 42)
+  (prn :wrote-and-read (ffi/read p :int64 0))
+  (ffi/free p))
+(prn :done)

host/chez/async.ss

@@ -21,20 +21,39 @@
 (define (jolt-async-sliding-buffer n)  (make-async-buffer n 'sliding))
 
 ;; --- channels ---------------------------------------------------------------
-;; items: a FIFO list of (value . box); box is #f for a buffered value or a 1-slot
-;; vector for an unbuffered rendezvous put (set #t when taken, waking the putter).
+;; items: an amortized-O(1) FIFO held as a mutable #(out in len) — `out` is the
+;; front (pop from its head), `in` holds pushed entries reversed onto it, `len` is
+;; the count (an append-to-a-list FIFO is O(n) per push and O(n) to measure).
+;; Each entry is (value . box); box is #f for a buffered value or a 1-slot vector
+;; for an unbuffered rendezvous put (set #t when taken, waking the putter).
 ;; cap 0 + kind 'unbuffered = rendezvous; cap>0 with kind fixed/dropping/sliding.
 (define-record-type async-chan
   (fields mu cv (mutable items) cap kind (mutable closed?) (mutable xrf))
   (nongenerative async-chan-v1))
 
-(define (ac-qlen ch) (length (async-chan-items ch)))
-(define (ac-qempty? ch) (null? (async-chan-items ch)))
-(define (ac-qpush! ch entry) (async-chan-items-set! ch (append (async-chan-items ch) (list entry))))
+(define (ac-qnew) (vector '() '() 0))
+(define (ac-qlen ch) (vector-ref (async-chan-items ch) 2))
+(define (ac-qempty? ch) (fx=? 0 (vector-ref (async-chan-items ch) 2)))
+(define (ac-qpush! ch entry)
+  (let ((q (async-chan-items ch)))
+    (vector-set! q 1 (cons entry (vector-ref q 1)))
+    (vector-set! q 2 (fx+ 1 (vector-ref q 2)))))
+(define (ac-qfront! q)                  ; ensure `out` is non-empty: out := reverse in
+  (when (null? (vector-ref q 0))
+    (vector-set! q 0 (reverse (vector-ref q 1)))
+    (vector-set! q 1 '())))
 (define (ac-qpop! ch)
-  (let ((e (car (async-chan-items ch))))
-    (async-chan-items-set! ch (cdr (async-chan-items ch))) e))
-(define (ac-qdrop-oldest! ch) (async-chan-items-set! ch (cdr (async-chan-items ch))))
+  (let ((q (async-chan-items ch)))
+    (ac-qfront! q)
+    (let ((out (vector-ref q 0)))
+      (vector-set! q 0 (cdr out))
+      (vector-set! q 2 (fx- (vector-ref q 2) 1))
+      (car out))))
+(define (ac-qdrop-oldest! ch)
+  (let ((q (async-chan-items ch)))
+    (ac-qfront! q)
+    (vector-set! q 0 (cdr (vector-ref q 0)))
+    (vector-set! q 2 (fx- (vector-ref q 2) 1))))
 
 ;; enqueue honoring the buffer kind (used by the transducer step + buffered puts).
 (define (ac-buf-give! ch v)
@@ -54,7 +73,7 @@
           ((null? (cdr args)) (car args))                     ; completion
           (else (ac-buf-give! ch (cadr args)) (car args)))))  ; step
 
-(define (ac-make cap kind xrf) (make-async-chan (make-mutex) (make-condition) '() cap kind #f xrf))
+(define (ac-make cap kind xrf) (make-async-chan (make-mutex) (make-condition) (ac-qnew) cap kind #f xrf))
 
 ;; (chan) | (chan n) | (chan buf) | (chan n|buf xform)
 (define (jolt-async-chan . args)
@@ -133,11 +152,19 @@
           (else ac-poll-empty))))
 
 ;; (alts! [ch ...]) — take from whichever channel is ready first; returns
-;; [value channel] (value nil if that channel closed). Take-only.
+;; [value channel] (value nil if that channel closed). Take-only: every port must
+;; be a channel — put specs [ch val] and the :default option are not supported, so
+;; reject them with a clear error instead of crashing inside ac-poll!.
 ;; Polls with a 1ms backoff — no cross-channel wait-set yet.
 (define ac-1ms (make-time 'time-duration 1000000 0))
 (define (jolt-async-alts chans)
   (let ((cs (seq->list (jolt-seq chans))))
+    (for-each (lambda (c)
+                (unless (async-chan? c)
+                  (jolt-throw (jolt-ex-info
+                                "alts! supports channel ports only (put specs [ch val] and :default are not supported)"
+                                (jolt-hash-map)))))
+              cs)
     (let loop ()
       (let try ((rest cs))
         (if (null? rest)

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)
-(set! jolt-str-render-one (lambda (x) (if (jbigdec? x) (jbigdec->string x) (%bd-str-render x))))
+(register-str-render! jbigdec? jbigdec->string)
 (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/build.ss

@@ -27,9 +27,12 @@
       (let ((l (get-line in)))
         (if (eof-object? l)
             (begin (close-port in)
-                   (let ((s (apply string-append (reverse acc))))
-                     ;; trim a trailing newline-equivalent (we joined without them)
-                     s))
+                   ;; rejoin with newlines (get-line stripped them). Callers use
+                   ;; single-line output; this just avoids silently concatenating
+                   ;; two lines into one corrupt token if a command emits more.
+                   (let ((ls (reverse acc)))
+                     (if (null? ls) ""
+                         (fold-left (lambda (s x) (string-append s "\n" x)) (car ls) (cdr ls)))))
             (loop (cons l acc)))))))
 
 (define (bld-system cmd)
@@ -138,36 +141,16 @@
   (for-each (lambda (l) (bld-inline-line l out 0)) bld-runtime-manifest))
 
 ;; --- app emission -----------------------------------------------------------
-;; Re-emit one app namespace to a list of Scheme strings. Like emit-image's
-;; ei-emit-ns but WITHOUT the silent (guard ...) wrapper — a form that fails to
-;; emit must fail the build, not vanish.
-(define (bld-emit-ns ns-name src)
-  (let loop ((forms (ei-read-all src)) (acc '()))
-    (if (null? forms)
-        (reverse acc)
-        (let ((f (car forms)))
-          (ce-scan-requires! f ns-name)
-          (cond
-            ((ei-ns-form? f) (loop (cdr forms) acc))
-            ((ce-macro-form? f)
-             (let-values (((nm fn-form) (ce-defmacro->fn f)))
-               (let ((scm (let ((ctx (make-analyze-ctx ns-name)))
-                            (jolt-ce-emit (jolt-ce-analyze ctx fn-form)))))
-                 (loop (cdr forms)
-                       (cons (string-append
-                               "(def-var! " (ei-str-lit ns-name) " " (ei-str-lit nm) "\n  "
-                               scm ")\n(mark-macro! "
-                               (ei-str-lit ns-name) " " (ei-str-lit nm) ")")
-                             acc)))))
-            (else
-             (let* ((ctx (make-analyze-ctx ns-name))
-                    (scm (jolt-ce-emit (jolt-ce-analyze ctx f))))
-               (loop (cdr forms) (cons scm acc)))))))))
+;; Re-emit one app namespace to a list of Scheme strings: optimize (run-passes)
+;; and stay strict — a form that fails to emit must fail the build, not vanish.
+;; The loop itself is emit-image's ei-emit-ns* (optimize? #t, guard? #f).
+(define (bld-emit-ns ns-name src) (ei-emit-ns* ns-name src #t #f))
 
 ;; --- the build --------------------------------------------------------------
 ;; entry-ns: the app's main namespace (a string). out-path: the binary to write.
-;; mode: "dev" | "release" | "optimized" (recorded; optimization passes wired in a
-;; later stage). Deps + source roots are already applied by the caller.
+;; mode: "dev" | "release" | "optimized". Every form runs through jolt.passes/
+;; run-passes (const-fold always; inline + type inference when optimized turns on
+;; direct-linking). Deps + source roots are already applied by the caller.
 (define (build-binary entry-ns out-path mode)
   (bld-check-toolchain)
   ;; 1. record app namespaces in dependency order as they finish loading.
@@ -181,9 +164,7 @@
         (error 'jolt-build (string-append "no source namespace loaded for " entry-ns
                                           " — is it on the source roots?")))
       ;; 2. emit each app namespace. `optimized` turns on the inference + flatten
-      ;; + scalar-replace passes (closed world). release/dev stay on proven
-      ;; var-deref codegen until those passes are validated on Chez — they were
-      ;; dormant before `jolt build` (inline-enabled? was hardwired off).
+      ;; + scalar-replace passes (closed world); release/dev get const-fold only.
       (set-optimize! (string=? mode "optimized"))
       (let* ((app-strs (apply append
                          (map (lambda (nf) (bld-emit-ns (car nf) (read-file-string (cdr nf))))

host/chez/collections.ss

@@ -243,7 +243,8 @@
        (cond ((pvec? coll) (let ((v (pvec-v coll)))
                              (if (and (fx>=? i 0) (fx<? i (vector-length v))) (vector-ref v i)
                                  (error 'nth "index out of bounds"))))
-             ((string? coll) (string-ref coll i))
+             ((string? coll) (if (and (fx>=? i 0) (fx<? i (string-length coll))) (string-ref coll i)
+                                 (error 'nth "index out of bounds")))
              ((or (cseq? coll) (empty-list-t? coll)) (seq-nth coll i #f jolt-nil))
              (else (error 'nth "unsupported collection")))))
     ((coll i d)

host/chez/compile-eval.ss

@@ -11,6 +11,10 @@
 
 (define jolt-ce-analyze (var-deref "jolt.analyzer" "analyze"))
 (define jolt-ce-emit (var-deref "jolt.backend-scheme" "emit"))
+;; jolt.passes/run-passes: const-fold every analyzed form, plus inline + type
+;; inference when the unit opted into direct-linking (jolt build --opt). Off that
+;; path it is a pure const-fold. Loaded from the compiler image (jolt.passes).
+(define jolt-ce-run-passes (var-deref "jolt.passes" "run-passes"))
 (define jolt-ce-read (var-deref "clojure.core" "read-string"))
 
 ;; The spine ALWAYS runs with the full clojure.core prelude loaded, so a clojure.*
@@ -59,13 +63,9 @@
 (define (jolt-analyze-emit-form form ns)
   (ce-scan-requires! form ns)
   (let* ((ctx (make-analyze-ctx ns))
-         (ir (jolt-ce-analyze ctx form)))
+         (ir (jolt-ce-run-passes (jolt-ce-analyze ctx form) ctx)))
     (jolt-ce-emit ir)))
 
-;; Source string -> Scheme source string (read then analyze -> emit, all on Chez).
-(define (jolt-analyze-emit src ns)
-  (jolt-analyze-emit-form (jolt-ce-read src) ns))
-
 ;; --- runtime defmacro -------------------------------------------------------
 ;; Shared with emit-image.ss (loaded after this). A defmacro lowers to a def of
 ;; its expander fn + a macro flag, exactly as the prelude emits build-time macros.

host/chez/concurrency.ss

@@ -96,7 +96,6 @@
                                 #t)))))
     cancelled))
 
-(define (jolt-future-done?* f) (and (jolt-future? f) (jolt-future-done? f)))
 (define (jolt-native-future-done? x)
   (if (jolt-future? x) (jolt-future-done? x)
       (jolt-throw (jolt-ex-info "future-done? requires a future" (jolt-hash-map)))))
@@ -158,22 +157,34 @@
   (let loop ((o opts) (validator jolt-nil))
     (cond
       ((or (null? o) (null? (cdr o)))
-       (make-jolt-agent state jolt-nil validator '() #f (make-mutex) (make-condition)))
+       (make-jolt-agent state jolt-nil validator (vector '() '()) #f (make-mutex) (make-condition)))
       ((and (keyword-t? (car o)) (string=? (keyword-t-name (car o)) "validator"))
        (loop (cddr o) (cadr o)))
       (else (loop (cddr o) validator)))))
 
+;; The action queue is an amortized-O(1) FIFO held as a mutable #(out in): `out` is
+;; the front, `in` holds sends reversed onto it (an append-to-a-list send was O(n)).
+;; All three helpers run under the agent mutex.
+(define (jagent-q-empty? a)
+  (let ((q (jolt-agent-queue a))) (and (null? (vector-ref q 0)) (null? (vector-ref q 1)))))
+(define (jagent-q-push! a entry)
+  (let ((q (jolt-agent-queue a))) (vector-set! q 1 (cons entry (vector-ref q 1)))))
+(define (jagent-q-pop! a)
+  (let ((q (jolt-agent-queue a)))
+    (when (null? (vector-ref q 0))
+      (vector-set! q 0 (reverse (vector-ref q 1))) (vector-set! q 1 '()))
+    (let ((out (vector-ref q 0))) (vector-set! q 0 (cdr out)) (car out))))
+
 ;; Drain the queue, applying each action (f state arg*) outside the lock (an action
 ;; may send/deref the same agent). A validator rejection or a thrown action puts the
 ;; agent in an error state and halts the queue (JVM :fail mode).
 (define (jolt-agent-worker a)
   (let loop ()
     (let ((act (with-mutex (jolt-agent-mu a)
-                 (if (or (not (jolt-nil? (jolt-agent-err a))) (null? (jolt-agent-queue a)))
+                 (if (or (not (jolt-nil? (jolt-agent-err a))) (jagent-q-empty? a))
                      (begin (jolt-agent-running?-set! a #f)
                             (condition-broadcast (jolt-agent-cv a)) #f)
-                     (let ((x (car (jolt-agent-queue a))))
-                       (jolt-agent-queue-set! a (cdr (jolt-agent-queue a))) x)))))
+                     (jagent-q-pop! a)))))
       (when act
         (guard (e (#t (with-mutex (jolt-agent-mu a)
                         (jolt-agent-err-set! a e)
@@ -190,7 +201,7 @@
 ;; the JVM's fixed/cached pool split.)
 (define (jolt-agent-send a f . args)
   (with-mutex (jolt-agent-mu a)
-    (jolt-agent-queue-set! a (append (jolt-agent-queue a) (list (cons f args))))
+    (jagent-q-push! a (cons f args))
     (unless (jolt-agent-running? a)
       (jolt-agent-running?-set! a #t)
       (fork-thread (lambda () (jolt-agent-worker a)))))
@@ -202,7 +213,7 @@
    (lambda (a)
      (with-mutex (jolt-agent-mu a)
        (let loop ()
-         (when (or (jolt-agent-running? a) (pair? (jolt-agent-queue a)))
+         (when (or (jolt-agent-running? a) (not (jagent-q-empty? a)))
            (condition-wait (jolt-agent-cv a) (jolt-agent-mu a)) (loop)))))
    agents)
   jolt-nil)

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
-;; printer (which renders collections with readable elements).
+;; str rendering for the value types not handled by the fast arms below. A host
+;; 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/emit-image.ss

@@ -35,7 +35,27 @@
 ;; + alias tables, not ctx-accumulated state, so this matches the spine's per-form
 ;; analyze. A defmacro emits its expander fn as (def-var! ns name <fn>) +
 ;; (mark-macro! ns name) so the on-Chez analyzer can expand it.
-(define (ei-emit-ns ns-name src)
+;; Analyze -> (optionally run passes) -> emit one form. optimize? runs
+;; jolt.passes/run-passes (build optimizes; the seed minter stays un-optimized so
+;; the self-host fixpoint is independent of the passes).
+(define (ei-compile-form ctx f optimize?)
+  (let ((ir (jolt-ce-analyze ctx f)))
+    (jolt-ce-emit (if optimize? (jolt-ce-run-passes ir ctx) ir))))
+
+;; The emitted `(def-var! …)(mark-macro! …)` pair for a defmacro, guard-wrapped
+;; (tolerant) or bare (strict) to match guard?.
+(define (ei-macro-string ns-name nm scm guard?)
+  (if guard?
+      (string-append "(guard (e (#t #f))\n  (def-var! " (ei-str-lit ns-name) " " (ei-str-lit nm)
+                     "\n    " scm ")\n  (mark-macro! " (ei-str-lit ns-name) " " (ei-str-lit nm) "))")
+      (string-append "(def-var! " (ei-str-lit ns-name) " " (ei-str-lit nm) "\n  " scm
+                     ")\n(mark-macro! " (ei-str-lit ns-name) " " (ei-str-lit nm) ")")))
+
+;; Cross-compile one namespace's source to a list of Scheme strings — shared by
+;; the seed minter (ei-emit-ns: optimize? #f, guard? #t — tolerant, skips a form
+;; that fails to emit) and `jolt build` (bld-emit-ns: optimize? #t, guard? #f —
+;; strict, a failing form errors the build).
+(define (ei-emit-ns* ns-name src optimize? guard?)
   (let loop ((forms (ei-read-all src)) (acc '()))
     (if (null? forms)
         (reverse acc)
@@ -45,35 +65,38 @@
             ((ei-ns-form? f) (loop (cdr forms) acc))
             ((ce-macro-form? f)
              (let-values (((nm fn-form) (ce-defmacro->fn f)))
-               (let ((scm (guard (e (#t #f))
-                            (let ((ctx (make-analyze-ctx ns-name)))
-                              (jolt-ce-emit (jolt-ce-analyze ctx fn-form))))))
+               (let ((scm (if guard?
+                              (guard (e (#t #f)) (ei-compile-form (make-analyze-ctx ns-name) fn-form optimize?))
+                              (ei-compile-form (make-analyze-ctx ns-name) fn-form optimize?))))
                  (loop (cdr forms)
-                       (if scm
-                           (cons (string-append
-                                   "(guard (e (#t #f))\n  (def-var! "
-                                   (ei-str-lit ns-name) " " (ei-str-lit nm) "\n    "
-                                   scm ")\n  (mark-macro! "
-                                   (ei-str-lit ns-name) " " (ei-str-lit nm) "))")
-                                 acc)
-                           acc)))))
+                       (if (and guard? (not scm)) acc
+                           (cons (ei-macro-string ns-name nm scm guard?) acc))))))
             (else
-             (let* ((ctx (make-analyze-ctx ns-name))
-                    (scm (guard (e (#t #f)) (jolt-ce-emit (jolt-ce-analyze ctx f)))))
+             (let ((scm (if guard?
+                            (guard (e (#t #f)) (ei-compile-form (make-analyze-ctx ns-name) f optimize?))
+                            (ei-compile-form (make-analyze-ctx ns-name) f optimize?))))
                (loop (cdr forms)
-                     (if scm
-                         (cons (string-append "(guard (e (#t #f))\n  " scm ")") acc)
-                         acc)))))))))
+                     (if (and guard? (not scm)) acc
+                         (cons (if guard? (string-append "(guard (e (#t #f))\n  " scm ")") scm) acc))))))))))
+
+(define (ei-emit-ns ns-name src) (ei-emit-ns* ns-name src #f #t))
 
 ;; Scheme string literal for a ns/name — uses the runtime's own writer
 ;; (printable ASCII identifiers only here).
 (define (ei-str-lit s) (with-output-to-string (lambda () (write s))))
 
-;; The compiler namespaces, in load order.
+;; The compiler namespaces, in load order. The passes (fold/inline/types + the
+;; jolt.passes façade) load after ir so run-passes is available to the back end;
+;; fold/inline/types come before the façade that :refers them.
 (define ei-compiler-ns-files
   (list (cons "jolt.ir" "jolt-core/jolt/ir.clj")
         (cons "jolt.analyzer" "jolt-core/jolt/analyzer.clj")
-        (cons "jolt.backend-scheme" "jolt-core/jolt/backend_scheme.clj")))
+        (cons "jolt.backend-scheme" "jolt-core/jolt/backend_scheme.clj")
+        (cons "jolt.passes.fold" "jolt-core/jolt/passes/fold.clj")
+        (cons "jolt.passes.inline" "jolt-core/jolt/passes/inline.clj")
+        (cons "jolt.passes.types.lattice" "jolt-core/jolt/passes/types/lattice.clj")
+        (cons "jolt.passes.types" "jolt-core/jolt/passes/types.clj")
+        (cons "jolt.passes" "jolt-core/jolt/passes.clj")))
 
 ;; The clojure.core tiers + stdlib namespaces, in load order.
 ;; Re-emitting these on Chez is the
@@ -81,7 +104,7 @@
 (define ei-prelude-ns-files
   (append
     (map (lambda (tf) (cons "clojure.core" (string-append "jolt-core/clojure/core/" tf ".clj")))
-         '("00-syntax" "00-kernel" "10-seq" "20-coll" "25-sorted" "30-macros" "40-lazy" "50-io"))
+         '("00-syntax" "00-kernel" "10-seq" "20-coll" "21-coll" "22-coll" "25-sorted" "30-macros" "40-lazy" "50-io"))
     (list (cons "clojure.string" "stdlib/clojure/string.clj")
           (cons "clojure.walk" "stdlib/clojure/walk.clj")
           (cons "clojure.template" "stdlib/clojure/template.clj")

host/chez/host-static-objects.ss

@@ -0,0 +1,502 @@
+;; host-static-objects.ss — host object classes (ArrayList, HashMap, the
+;; String/Reader/Writer/Tokenizer shims, BigInteger/MapEntry ctors, URL codecs)
+;; and the tagged-table method dispatch + pluggable instance? hook. Continues
+;; host-static-statics.ss; loaded last of the three.
+
+;; ---- java.util.ArrayList ----------------------------------------------------
+;; A mutable list backed by a growable Scheme vector. State is #(backing count);
+;; .add amortizes O(1) and .get is O(1) (a list backing made both O(n)). medley's
+;; stateful transducers (window / partition-between) build one with .add / .size /
+;; .toArray / .clear / .remove. (ArrayList.) | (ArrayList. n) | (ArrayList. coll).
+(define al-min-cap 8)
+(define (al-vec self) (vector-ref (jhost-state self) 0))
+(define (al-cnt self) (vector-ref (jhost-state self) 1))
+(define (al-cnt! self n) (vector-set! (jhost-state self) 1 n))
+(define (make-arraylist xs)               ; xs: a Scheme list of initial elements
+  (let* ((n (length xs)) (cap (fxmax al-min-cap n)) (v (make-vector cap jolt-nil)))
+    (let loop ((i 0) (xs xs)) (when (pair? xs) (vector-set! v i (car xs)) (loop (fx+ i 1) (cdr xs))))
+    (make-jhost "arraylist" (vector v n))))
+(define (al-ensure! self need)            ; grow the backing vector (doubling) to fit `need`
+  (let ((v (al-vec self)))
+    (when (fx>? need (vector-length v))
+      (let grow ((cap (fxmax al-min-cap (vector-length v))))
+        (if (fx<? cap need) (grow (fx* cap 2))
+            (let ((nv (make-vector cap jolt-nil)))
+              (let cp ((i 0)) (when (fx<? i (al-cnt self)) (vector-set! nv i (vector-ref v i)) (cp (fx+ i 1))))
+              (vector-set! (jhost-state self) 0 nv)))))))
+(define (al-push! self x)
+  (let ((n (al-cnt self))) (al-ensure! self (fx+ n 1)) (vector-set! (al-vec self) n x) (al-cnt! self (fx+ n 1))))
+(define (al-insert-at! self i x)
+  (let ((n (al-cnt self)))
+    (al-ensure! self (fx+ n 1))
+    (let ((v (al-vec self)))
+      (let shift ((j n)) (when (fx>? j i) (vector-set! v j (vector-ref v (fx- j 1))) (shift (fx- j 1))))
+      (vector-set! v i x) (al-cnt! self (fx+ n 1)))))
+(define (al-remove-at! self i)
+  (let ((n (al-cnt self)) (v (al-vec self)))
+    (let shift ((j i)) (when (fx<? j (fx- n 1)) (vector-set! v j (vector-ref v (fx+ j 1))) (shift (fx+ j 1))))
+    (vector-set! v (fx- n 1) jolt-nil) (al-cnt! self (fx- n 1))))
+(define (al->list self)                   ; first `count` elements as a Scheme list
+  (let ((v (al-vec self)))
+    (let loop ((i (fx- (al-cnt self) 1)) (acc '())) (if (fx<? i 0) acc (loop (fx- i 1) (cons (vector-ref v i) acc))))))
+(register-class-ctor! "ArrayList"
+  (lambda args
+    (cond ((null? args) (make-arraylist '()))
+          ((number? (car args)) (make-arraylist '()))   ; initial capacity, ignored
+          (else (make-arraylist (seq->list (jolt-seq (car args))))))))
+(register-class-ctor! "java.util.ArrayList"
+  (lambda args
+    (cond ((null? args) (make-arraylist '()))
+          ((number? (car args)) (make-arraylist '()))
+          (else (make-arraylist (seq->list (jolt-seq (car args))))))))
+(register-host-methods! "arraylist"
+  (list
+    (cons "add" (lambda (self . a)
+                  ;; (.add x) -> append+true; (.add i x) -> insert at i, returns nil.
+                  (if (= 1 (length a))
+                      (begin (al-push! self (car a)) #t)
+                      (begin (al-insert-at! self (jnum->exact (car a)) (cadr a)) jolt-nil))))
+    (cons "add!" (lambda (self x) (al-push! self x) #t))
+    (cons "get" (lambda (self i) (vector-ref (al-vec self) (jnum->exact i))))
+    (cons "set" (lambda (self i x)
+                  (let* ((idx (jnum->exact i)) (old (vector-ref (al-vec self) idx)))
+                    (vector-set! (al-vec self) idx x) old)))
+    (cons "size" (lambda (self) (->num (al-cnt self))))
+    (cons "isEmpty" (lambda (self) (fx=? 0 (al-cnt self))))
+    (cons "remove" (lambda (self i)
+                     (let* ((idx (jnum->exact i)) (old (vector-ref (al-vec self) idx)))
+                       (al-remove-at! self idx) old)))
+    (cons "clear" (lambda (self) (vector-set! (jhost-state self) 0 (make-vector al-min-cap jolt-nil)) (al-cnt! self 0) jolt-nil))
+    (cons "contains" (lambda (self x) (and (memp (lambda (e) (jolt=2 e x)) (al->list self)) #t)))
+    (cons "toArray" (lambda (self . _) (apply jolt-vector (al->list self))))
+    (cons "iterator" (lambda (self) (make-jiterator (list->cseq (al->list self)))))
+    (cons "toString" (lambda (self) (jolt-pr-str (list->cseq (al->list self)))))))
+
+(register-class-ctor! "StringBuilder"
+  (lambda args (make-jhost "string-builder"
+    ;; a numeric first arg is a CAPACITY hint, not content.
+    (vector (if (and (pair? args) (not (number? (car args)))) (render-piece (car args)) "")))))
+(register-host-methods! "string-builder"
+  (list (cons "append" (lambda (self x) (sb-set! self (string-append (sb-str self) (render-piece x))) self))
+        (cons "toString" (lambda (self) (sb-str self)))
+        (cons "length" (lambda (self) (->num (string-length (sb-str self)))))
+        (cons "charAt" (lambda (self i) (string-ref (sb-str self) (jnum->exact i))))
+        (cons "setLength" (lambda (self n)
+                            (let ((cur (sb-str self)) (n (jnum->exact n)))
+                              (sb-set! self (if (< n (string-length cur))
+                                                (substring cur 0 n)
+                                                (string-append cur (make-string (- n (string-length cur)) #\nul)))))
+                            jolt-nil))))
+
+;; ---- StringWriter -----------------------------------------------------------
+;; Writer.write(int) writes the CHAR for that code; append(char) appends the char.
+(define (writer-piece x) (if (number? x) (string (integer->char (jnum->exact x))) (render-piece x)))
+(register-class-ctor! "StringWriter" (lambda args (make-jhost "writer" (vector ""))))
+(register-host-methods! "writer"
+  (list (cons "write" (lambda (self x) (sb-set! self (string-append (sb-str self) (writer-piece x))) jolt-nil))
+        (cons "append" (lambda (self x) (sb-set! self (string-append (sb-str self) (render-piece x))) self))
+        (cons "flush" (lambda (self) jolt-nil))
+        (cons "close" (lambda (self) jolt-nil))
+        (cons "toString" (lambda (self) (sb-str self)))))
+
+;; a file-backed writer (clojure.java.io/writer of a File/path): accumulates like
+;; StringWriter, then persists to the path on flush/close, so
+;; (with-open [w (io/writer "f")] (.write w …)) writes the file. State #(path buf).
+(define (fw-path self) (vector-ref (jhost-state self) 0))
+(define (fw-buf self) (vector-ref (jhost-state self) 1))
+(define (fw-append! self s) (vector-set! (jhost-state self) 1 (string-append (fw-buf self) s)))
+(define (fw-flush! self) (jolt-spit (fw-path self) (fw-buf self)))  ; jolt-spit: io.ss
+(register-host-methods! "file-writer"
+  (list (cons "write" (lambda (self x) (fw-append! self (writer-piece x)) jolt-nil))
+        (cons "append" (lambda (self x) (fw-append! self (render-piece x)) self))
+        (cons "flush" (lambda (self) (fw-flush! self) jolt-nil))
+        (cons "close" (lambda (self) (fw-flush! self) jolt-nil))
+        (cons "toString" (lambda (self) (fw-buf self)))))
+
+;; a writer over a real Chez port — the values *out* / *err* hold. write/append
+;; push to the port (so (.write *out* s) and (binding [*out* *err*] …) work);
+;; it isn't a buffer, so toString is empty. Lets libraries that touch *out*/*err*
+;; (tools.logging, selmer) compile and run.
+(register-host-methods! "port-writer"
+  (list (cons "write" (lambda (self x) (display (writer-piece x) (vector-ref (jhost-state self) 0)) jolt-nil))
+        (cons "append" (lambda (self x) (display (render-piece x) (vector-ref (jhost-state self) 0)) self))
+        (cons "flush" (lambda (self) (flush-output-port (vector-ref (jhost-state self) 0)) jolt-nil))
+        (cons "close" (lambda (self) jolt-nil))
+        (cons "toString" (lambda (self) ""))))
+(def-var! "clojure.core" "*out*" (make-jhost "port-writer" (vector (current-output-port))))
+(def-var! "clojure.core" "*err*" (make-jhost "port-writer" (vector (current-error-port))))
+
+;; ---- java.util.HashMap ------------------------------------------------------
+;; A mutable map keyed by jolt values (jolt-hash / jolt=2). State #(chez-hashtable).
+;; Constructors: () | (capacity) | (capacity load-factor) [sizing args ignored] |
+;; (Map m) [copy]. Enough of the Map surface for libraries that build a fast lookup
+;; (malli's fast-registry: (doto (HashMap. 1024 0.25) (.putAll m)) then .get).
+(define (hm-hash k) (let ((h (jolt-hash k)))
+                      (bitwise-and (if (and (integer? h) (exact? h)) (abs h) 0) #x3FFFFFFF)))
+(define (hm-tbl self) (vector-ref (jhost-state self) 0))
+(define (hm-hashmap? x) (and (jhost? x) (string=? (jhost-tag x) "hashmap")))
+(define (hm-copy-into! ht src)            ; src: a jolt map or another hashmap
+  (if (hm-hashmap? src)
+      (vector-for-each (lambda (k) (hashtable-set! ht k (hashtable-ref (hm-tbl src) k jolt-nil)))
+                       (hashtable-keys (hm-tbl src)))
+      (for-each (lambda (e) (hashtable-set! ht (jolt-nth e 0) (jolt-nth e 1)))
+                (seq->list (jolt-seq src)))))
+(register-class-ctor! "HashMap"
+  (lambda args
+    (let ((ht (make-hashtable hm-hash jolt=2)))
+      (when (and (pair? args) (or (pmap? (car args)) (hm-hashmap? (car args))))
+        (hm-copy-into! ht (car args)))
+      (make-jhost "hashmap" (vector ht)))))
+(define (hm->pmap self)
+  (let ((m (jolt-hash-map)))
+    (vector-for-each (lambda (k) (set! m (jolt-assoc m k (hashtable-ref (hm-tbl self) k jolt-nil))))
+                     (hashtable-keys (hm-tbl self)))
+    m))
+(register-host-methods! "hashmap"
+  (list (cons "put" (lambda (self k v) (let ((old (hashtable-ref (hm-tbl self) k jolt-nil)))
+                                          (hashtable-set! (hm-tbl self) k v) old)))
+        (cons "get" (lambda (self k) (hashtable-ref (hm-tbl self) k jolt-nil)))
+        (cons "getOrDefault" (lambda (self k d) (hashtable-ref (hm-tbl self) k d)))
+        (cons "containsKey" (lambda (self k) (if (hashtable-contains? (hm-tbl self) k) #t #f)))
+        (cons "containsValue" (lambda (self v)
+          (let ((found #f))
+            (vector-for-each (lambda (k) (when (jolt=2 v (hashtable-ref (hm-tbl self) k jolt-nil)) (set! found #t)))
+                             (hashtable-keys (hm-tbl self))) found)))
+        (cons "size" (lambda (self) (hashtable-size (hm-tbl self))))
+        (cons "isEmpty" (lambda (self) (= 0 (hashtable-size (hm-tbl self)))))
+        (cons "remove" (lambda (self k) (let ((old (hashtable-ref (hm-tbl self) k jolt-nil)))
+                                           (hashtable-delete! (hm-tbl self) k) old)))
+        (cons "clear" (lambda (self) (hashtable-clear! (hm-tbl self)) jolt-nil))
+        (cons "putAll" (lambda (self m) (hm-copy-into! (hm-tbl self) m) jolt-nil))
+        (cons "keySet" (lambda (self) (apply jolt-hash-set (vector->list (hashtable-keys (hm-tbl self))))))
+        (cons "values" (lambda (self) (apply jolt-vector
+                          (map (lambda (k) (hashtable-ref (hm-tbl self) k jolt-nil))
+                               (vector->list (hashtable-keys (hm-tbl self)))))))
+        (cons "entrySet" (lambda (self) (jolt-seq (hm->pmap self))))
+        (cons "toString" (lambda (self) (jolt-pr-str (hm->pmap self))))))
+
+;; ---- StringReader -----------------------------------------------------------
+;; state: a vector #(string pos marked).
+(register-class-ctor! "StringReader"
+  ;; src is a String or a char[] ((StringReader. (char-array s)) — selmer's parser
+  ;; reads templates this way); a char-array becomes the string of its chars.
+  (lambda (src . _)
+    (make-jhost "string-reader"
+      (vector (cond ((string? src) src)
+                    ((jolt-array? src) (apply string-append (map jolt-str-render-one (seq->list (jolt-seq src)))))
+                    (else (jolt-str-render-one src)))
+              0 0))))
+(define (sr-s self) (vector-ref (jhost-state self) 0))
+(define (sr-pos self) (vector-ref (jhost-state self) 1))
+(define (sr-pos! self p) (vector-set! (jhost-state self) 1 p))
+(register-host-methods! "string-reader"
+  (list (cons "read" (lambda (self)
+                       (let ((s (sr-s self)) (p (sr-pos self)))
+                         (if (>= p (string-length s)) -1   ; EOF -> exact int -1 (= JVM)
+                             (begin (sr-pos! self (+ p 1)) (->num (char->integer (string-ref s p))))))))
+        (cons "mark" (lambda (self . _) (vector-set! (jhost-state self) 2 (sr-pos self)) jolt-nil))
+        (cons "reset" (lambda (self) (sr-pos! self (vector-ref (jhost-state self) 2)) jolt-nil))
+        (cons "skip" (lambda (self n) (let ((n (jnum->exact n)))
+                                        (sr-pos! self (min (string-length (sr-s self)) (+ (sr-pos self) n))) (->num n))))
+        ;; readLine: the next line without its terminator (\n or \r\n), nil at EOF —
+        ;; what line-seq drives over a BufferedReader.
+        (cons "readLine"
+          (lambda (self)
+            (let ((s (sr-s self)) (p (sr-pos self)) (len (string-length (sr-s self))))
+              (if (>= p len) jolt-nil
+                  (let scan ((i p))
+                    (cond
+                      ((>= i len) (sr-pos! self len) (substring s p len))
+                      ((char=? (string-ref s i) #\newline)
+                       (sr-pos! self (+ i 1))
+                       (substring s p (if (and (> i p) (char=? (string-ref s (- i 1)) #\return)) (- i 1) i)))
+                      (else (scan (+ i 1)))))))))
+        (cons "close" (lambda (self) jolt-nil))))
+
+;; ---- PushbackReader ---------------------------------------------------------
+;; state: a vector #(wrapped-reader pushed-list)
+(register-class-ctor! "PushbackReader"
+  (lambda (rdr . _) (make-jhost "pushback-reader" (vector rdr '()))))
+(define (read-unit r)        ; read one code unit (flonum) from any reader, -1 at EOF
+  (record-method-dispatch r "read" jolt-nil))
+(register-host-methods! "pushback-reader"
+  (list (cons "read" (lambda (self)
+                       (let ((pushed (vector-ref (jhost-state self) 1)))
+                         (if (pair? pushed)
+                             (begin (vector-set! (jhost-state self) 1 (cdr pushed)) (car pushed))
+                             (read-unit (vector-ref (jhost-state self) 0))))))
+        (cons "unread" (lambda (self ch)
+                         (vector-set! (jhost-state self) 1
+                           (cons (if (char? ch) (->num (char->integer ch)) ch) (vector-ref (jhost-state self) 1)))
+                         jolt-nil))
+        (cons "close" (lambda (self) jolt-nil))))
+
+;; ---- StringTokenizer --------------------------------------------------------
+;; state: a vector #(tokens-list pos)
+(define (tokenize s delims)
+  (let ((dset (string->list delims)))
+    (let loop ((chars (string->list s)) (cur '()) (toks '()))
+      (cond ((null? chars) (reverse (if (null? cur) toks (cons (list->string (reverse cur)) toks))))
+            ((memv (car chars) dset)
+             (loop (cdr chars) '() (if (null? cur) toks (cons (list->string (reverse cur)) toks))))
+            (else (loop (cdr chars) (cons (car chars) cur) toks))))))
+(register-class-ctor! "StringTokenizer"
+  (lambda (s . delims) (make-jhost "string-tokenizer"
+    (vector (tokenize (if (string? s) s (jolt-str-render-one s))
+                      (if (null? delims) " \t\n\r\f" (car delims))) 0))))
+(register-host-methods! "string-tokenizer"
+  (list (cons "hasMoreTokens" (lambda (self) (< (vector-ref (jhost-state self) 1) (length (vector-ref (jhost-state self) 0)))))
+        (cons "countTokens" (lambda (self) (->num (- (length (vector-ref (jhost-state self) 0)) (vector-ref (jhost-state self) 1)))))
+        (cons "nextToken" (lambda (self)
+                            (let ((toks (vector-ref (jhost-state self) 0)) (p (vector-ref (jhost-state self) 1)))
+                              (if (< p (length toks))
+                                  (begin (vector-set! (jhost-state self) 1 (+ p 1)) (list-ref toks p))
+                                  (error #f "NoSuchElementException")))))))
+
+;; ---- String / BigInteger / MapEntry constructors ----------------------------
+;; (String. bytes [charset]) decodes bytes (a bytevector OR a jolt byte-array)
+;; with the named charset (UTF-8 default; ISO-8859-1/latin1/ascii = one byte per
+;; char); else stringify. clj-http-lite's body coercion is (String. ^[B body cs).
+(define (string-charset-name rest)
+  (if (pair? rest)
+      (let ((c (car rest)))
+        (cond ((string? c) c)
+              ((and (jhost? c) (string=? (jhost-tag c) "charset"))
+               (let ((p (assq 'name (jhost-state c)))) (if p (jolt-str-render-one (cdr p)) "UTF-8")))
+              (else "UTF-8")))
+      "UTF-8"))
+(define (decode-bytevector bv rest)
+  (let ((cs (ascii-string-down (string-charset-name rest))))
+    (cond
+      ((or (string=? cs "utf-8") (string=? cs "utf8")) (utf8->string bv))
+      ((or (string=? cs "iso-8859-1") (string=? cs "latin1") (string=? cs "iso8859-1")
+           (string=? cs "us-ascii") (string=? cs "ascii"))
+       (list->string (map integer->char (bytevector->u8-list bv))))
+      ((or (string=? cs "utf-16") (string=? cs "utf16") (string=? cs "utf-16be") (string=? cs "unicode"))
+       (utf16->string bv (endianness big)))   ; respects a leading BOM
+      ((string=? cs "utf-16le") (utf16->string bv (endianness little)))
+      ((or (string=? cs "utf-32") (string=? cs "utf32") (string=? cs "utf-32be"))
+       (utf32->string bv (endianness big)))
+      ((string=? cs "utf-32le") (utf32->string bv (endianness little)))
+      (else (guard (e (#t (list->string (map integer->char (bytevector->u8-list bv))))) (utf8->string bv))))))
+(register-class-ctor! "String"
+  (lambda (x . rest)
+    (cond ((bytevector? x) (decode-bytevector x rest))
+          ((and (jolt-array? x) (eq? (jolt-array-kind x) 'byte)) (decode-bytevector (na-bytearray->bv x) rest))
+          ((string? x) x)
+          (else (jolt-str-render-one x)))))
+(register-class-ctor! "BigInteger"
+  (lambda (v) (parse-int-or-throw v 10 "BigInteger")))
+(register-class-ctor! "MapEntry" (lambda (k v) (make-map-entry k v)))
+;; JVM exception ctors -> a typed host throwable carrying the canonical :jolt/class
+;; (so class / instance? / getMessage / ex-message reflect the real type) and the
+;; message. Supports (E. msg), (E. msg cause), (E. cause), and (E.).
+(for-each
+  (lambda (nm)
+    (let ((canonical (or (resolve-class-hint nm) nm)))
+      (register-class-ctor! nm
+        (lambda args
+          (let* ((a0 (if (pair? args) (car args) jolt-nil))
+                 (rest (if (pair? args) (cdr args) '()))
+                 (cause (if (pair? rest) (car rest) jolt-nil)))
+            (cond
+              ((string? a0) (jolt-host-throwable canonical a0 cause))
+              ((jolt-nil? a0) (jolt-host-throwable canonical jolt-nil))
+              ;; (E. cause): a lone throwable arg is the cause, message nil.
+              ((and (null? rest) (ex-info-map? a0)) (jolt-host-throwable canonical jolt-nil a0))
+              (else (jolt-host-throwable canonical (jolt-str-render-one a0) cause))))))))
+  '("Throwable" "Exception" "RuntimeException" "IllegalArgumentException" "IllegalStateException"
+    "InterruptedException" "UnsupportedOperationException" "IOException" "NumberFormatException"
+    "ArithmeticException" "NullPointerException" "ClassCastException" "IndexOutOfBoundsException"
+    "FileNotFoundException" "UnsupportedEncodingException"))
+
+;; ---- URLEncoder / URLDecoder (www-form-urlencoded) --------------------------
+(define (url-unreserved? b)
+  (or (and (>= b 48) (<= b 57)) (and (>= b 65) (<= b 90)) (and (>= b 97) (<= b 122))
+      (= b 46) (= b 42) (= b 95) (= b 45)))
+(define hex-digits "0123456789ABCDEF")
+(define (url-encode s . _)
+  (let ((bs (string->utf8 (if (string? s) s (jolt-str-render-one s)))) (out '()))
+    (let loop ((i 0))
+      (if (= i (bytevector-length bs)) (list->string (reverse out))
+          (let ((b (bytevector-u8-ref bs i)))
+            (cond ((url-unreserved? b) (set! out (cons (integer->char b) out)))
+                  ((= b 32) (set! out (cons #\+ out)))
+                  (else (set! out (cons (string-ref hex-digits (bitwise-and b 15))
+                                   (cons (string-ref hex-digits (bitwise-arithmetic-shift-right b 4))
+                                     (cons #\% out))))))
+            (loop (+ i 1)))))))
+(define (hexv c)
+  (cond ((and (char<=? #\0 c) (char<=? c #\9)) (- (char->integer c) 48))
+        ((and (char<=? #\A c) (char<=? c #\F)) (- (char->integer c) 55))
+        ((and (char<=? #\a c) (char<=? c #\f)) (- (char->integer c) 87))
+        (else (error #f "URLDecoder: malformed escape"))))
+(define (url-decode s . _)
+  (let* ((str (if (string? s) s (jolt-str-render-one s))) (n (string-length str)) (out '()))
+    (let loop ((i 0))
+      (if (>= i n) (utf8->string (u8-list->bytevector (reverse out)))
+          (let ((c (string-ref str i)))
+            (cond ((char=? c #\+) (set! out (cons 32 out)) (loop (+ i 1)))
+                  ((char=? c #\%)
+                   (set! out (cons (+ (* 16 (hexv (string-ref str (+ i 1)))) (hexv (string-ref str (+ i 2)))) out))
+                   (loop (+ i 3)))
+                  (else (set! out (cons (char->integer c) out)) (loop (+ i 1)))))))))
+(define (u8-list->bytevector lst)
+  (let ((bv (make-bytevector (length lst))))
+    (let loop ((l lst) (i 0)) (if (null? l) bv (begin (bytevector-u8-set! bv i (car l)) (loop (cdr l) (+ i 1)))))))
+(register-class-statics! "URLEncoder" (list (cons "encode" url-encode)))
+(register-class-statics! "URLDecoder" (list (cons "decode" url-decode)))
+;; Charset/forName yields the canonical name STRING (not an opaque object) so it
+;; threads straight into (.getBytes s cs) / (String. bytes cs), which take a name.
+(register-class-statics! "Charset" (list (cons "forName" (lambda (nm) (jolt-str-render-one nm)))))
+
+;; ---- Base64 (RFC 4648) ------------------------------------------------------
+(define b64-alphabet "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/")
+(define (->bytevector x)
+  (cond ((bytevector? x) x)
+        ((and (jolt-array? x) (eq? (jolt-array-kind x) 'byte)) (na-bytearray->bv x))
+        ((string? x) (string->utf8 x))
+        (else (string->utf8 (jolt-str-render-one x)))))
+(define (b64-encode x)
+  (let* ((bs (->bytevector x)) (n (bytevector-length bs)) (out '()))
+    (let loop ((i 0))
+      (if (>= i n) (list->string (reverse out))
+          (let* ((b0 (bytevector-u8-ref bs i))
+                 (b1 (if (< (+ i 1) n) (bytevector-u8-ref bs (+ i 1)) #f))
+                 (b2 (if (< (+ i 2) n) (bytevector-u8-ref bs (+ i 2)) #f)))
+            (set! out (cons (string-ref b64-alphabet (bitwise-arithmetic-shift-right b0 2)) out))
+            (set! out (cons (string-ref b64-alphabet (bitwise-ior (bitwise-arithmetic-shift-left (bitwise-and b0 3) 4)
+                                                                  (bitwise-arithmetic-shift-right (or b1 0) 4))) out))
+            (set! out (cons (if b1 (string-ref b64-alphabet (bitwise-ior (bitwise-arithmetic-shift-left (bitwise-and b1 15) 2)
+                                                                         (bitwise-arithmetic-shift-right (or b2 0) 6))) #\=) out))
+            (set! out (cons (if b2 (string-ref b64-alphabet (bitwise-and b2 63)) #\=) out))
+            (loop (+ i 3)))))))
+(define (b64-char-val c)
+  (let loop ((i 0)) (cond ((= i 64) (error #f "Base64: illegal character")) ((char=? (string-ref b64-alphabet i) c) i) (else (loop (+ i 1))))))
+(define (b64-decode x)
+  (let* ((str (let ((s (if (string? x) x (utf8->string (->bytevector x)))))
+                (list->string (filter (lambda (c) (not (char=? c #\=))) (string->list s)))))
+         (out '()) (acc 0) (bits 0))
+    (for-each (lambda (c)
+                (set! acc (bitwise-ior (bitwise-arithmetic-shift-left acc 6) (b64-char-val c)))
+                (set! bits (+ bits 6))
+                (when (>= bits 8)
+                  (set! bits (- bits 8))
+                  (set! out (cons (bitwise-and (bitwise-arithmetic-shift-right acc bits) 255) out))))
+              (string->list str))
+    (u8-list->bytevector (reverse out))))
+(register-host-methods! "b64-encoder"
+  (list (cons "encode" (lambda (self bs) (string->utf8 (b64-encode bs))))
+        (cons "encodeToString" (lambda (self bs) (b64-encode bs)))))
+(register-host-methods! "b64-decoder"
+  (list (cons "decode" (lambda (self s) (b64-decode s)))))
+(register-class-statics! "Base64"
+  (list (cons "getEncoder" (lambda () (make-jhost "b64-encoder" '())))
+        (cons "getDecoder" (lambda () (make-jhost "b64-decoder" '())))))
+
+;; ---- java.util.regex.Pattern ------------------------------------------------
+;; Pattern/compile returns a jolt-regex value (regex-t), so str/replace, re-find,
+;; .split etc. accept it transparently.
+(define pattern-multiline 8.0)
+(define (pattern-quote s)
+  (let ((meta "\\.[]{}()*+-?^$|&") (s (if (string? s) s (jolt-str-render-one s))) (out '()))
+    (let loop ((i 0))
+      (if (= i (string-length s)) (list->string (reverse out))
+          (let ((c (string-ref s i)))
+            (when (memv c (string->list meta)) (set! out (cons #\\ out)))
+            (set! out (cons c out))
+            (loop (+ i 1)))))))
+(register-class-statics! "Pattern"
+  (list (cons "compile" (lambda (s . flags)
+                          (if (and (pair? flags) (= (bitwise-and (jnum->exact (car flags)) 8) 8))
+                              (jolt-regex (string-append "(?m)" s))
+                              (jolt-regex s))))
+        (cons "quote" (lambda (s) (pattern-quote s)))
+        (cons "MULTILINE" pattern-multiline)))
+;; record-method-dispatch already routes string? -> jolt-string-method. Add a
+;; regex-t arm (Pattern .split / .matcher-less surface used by corpus) by wrapping
+;; once more — a regex-t isn't a jhost.
+(define %hs-rmd2 record-method-dispatch)
+(set! record-method-dispatch
+  (lambda (obj method-name rest-args)
+    (if (regex-t? obj)
+        (let ((rest (if (jolt-nil? rest-args) '() (seq->list rest-args))))
+          (cond ((string=? method-name "split")
+                 ;; .split returns a String[] — a seq (prints
+                 ;; (a b c), not a vector). re-split with no limit; drop trailing
+                 ;; empties (JVM default).
+                 (let ((parts (re-split (regex-t-irx obj) (car rest) #f)))
+                   (list->cseq (str-split-drop-trailing parts))))
+                ((string=? method-name "pattern") (regex-t-source obj))
+                (else (error #f (string-append "No method " method-name " on Pattern")))))
+        (%hs-rmd2 obj method-name rest-args))))
+
+;; ---- def-var! the registry entry points so emit can also reach them ---------
+(def-var! "clojure.core" "host-static-ref" host-static-ref)
+(def-var! "clojure.core" "host-static-call" (lambda (c m . a) (apply host-static-call c m a)))
+(def-var! "clojure.core" "host-new" (lambda (c . a) (apply host-new c a)))
+
+;; Clojure-visible class-registration hooks. A host shim (e.g. reitit.trie-jolt,
+;; which mirrors the reitit.Trie Java class) registers a constructor proc or a
+;; map of static members against a class token so (Class. args) / (Class/member
+;; args) resolve to it. The statics argument is a jolt map {member-name -> val}.
+(define (jmap->static-alist m)
+  (let loop ((s (jolt-seq m)) (acc '()))
+    (if (jolt-nil? s) acc
+        (let ((e (jolt-first s)))
+          (loop (jolt-seq (jolt-rest s)) (cons (cons (jolt-nth e 0) (jolt-nth e 1)) acc))))))
+(def-var! "clojure.core" "__register-class-ctor!"
+  (lambda (name proc) (register-class-ctor! name proc) jolt-nil))
+(def-var! "clojure.core" "__register-class-statics!"
+  (lambda (name members) (register-class-statics! name (jmap->static-alist members)) jolt-nil))
+
+;; ---- tagged-table method dispatch + pluggable instance? --------------------
+;; A jolt library can build stateful host objects with (jolt.host/tagged-table
+;; tag) and dispatch (.method obj ...) to handlers registered here, keyed by the
+;; table's "jolt/type" tag — the htable analogue of the jhost method registry
+;; above. jolt-lang/http-client uses this to emulate java.net URL /
+;; HttpURLConnection / java.io byte streams so clj-http-lite runs unchanged.
+(define tagged-methods-tbl (make-hashtable string-hash string=?))   ; tag-key -> (method-ht)
+(define (tag->method-key tag)
+  (if (keyword-t? tag)
+      (let ((ns (keyword-t-ns tag)))
+        (if (and ns (not (jolt-nil? ns))) (string-append ns "/" (keyword-t-name tag)) (keyword-t-name tag)))
+      (jolt-str-render-one tag)))
+(define (register-tagged-methods! tag members)
+  (let* ((key (tag->method-key tag))
+         (h (or (hashtable-ref tagged-methods-tbl key #f)
+                (let ((nh (make-hashtable string-hash string=?)))
+                  (hashtable-set! tagged-methods-tbl key nh) nh))))
+    (for-each (lambda (p) (hashtable-set! h (car p) (cdr p))) members)))
+
+;; htable arm: dispatch (.method obj a*) through the table's tag method registry;
+;; an unregistered method falls through (sorted colls are htables too).
+(define %hs-rmd-htable record-method-dispatch)
+(set! record-method-dispatch
+  (lambda (obj method-name rest-args)
+    (let ((tag (and (htable? obj) (hashtable-ref (htable-h obj) "jolt/type" #f))))
+      (let* ((mh (and tag (hashtable-ref tagged-methods-tbl (tag->method-key tag) #f)))
+             (f  (and mh (hashtable-ref mh method-name #f))))
+        (if f
+            (apply f obj (if (jolt-nil? rest-args) '() (seq->list rest-args)))
+            (%hs-rmd-htable obj method-name rest-args))))))
+
+(def-var! "clojure.core" "__register-class-methods!"
+  (lambda (tag members) (register-tagged-methods! tag (jmap->static-alist members)) jolt-nil))
+
+;; 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 '())
+(register-instance-check-arm!
+  (lambda (type-sym val)
+    (let ((tname (symbol-t-name type-sym)))
+      (let loop ((fs user-instance-checks))
+        (if (null? fs)
+            'pass
+            (let ((r ((car fs) tname val)))
+              (if (jolt-nil? r) (loop (cdr fs)) (if (jolt-truthy? r) #t #f))))))))
+(def-var! "clojure.core" "__register-instance-check!"
+  (lambda (f) (set! user-instance-checks (append user-instance-checks (list f))) jolt-nil))
+
+;; (jolt.host/table? x) — is x a host tagged-table?
+(def-var! "jolt.host" "table?" (lambda (x) (if (htable? x) #t #f)))

host/chez/host-static-statics.ss

@@ -0,0 +1,288 @@
+;; host-static-statics.ss — java.lang / java.util.* static methods and the
+;; NumberFormat / Class registries. Continues host-static.ss (its registries +
+;; jhost record + coercion helpers); loaded right after it.
+
+;; ---- java.lang statics ------------------------------------------------------
+;; java.lang.Math: sqrt/pow/floor/ceil/trig/log/exp always return a DOUBLE on the
+;; JVM (Chez's sqrt/expt return EXACT for exact args, e.g. (sqrt 9) -> 3), so coerce
+;; to flonum. round -> long (exact); abs/max/min preserve the argument's type.
+(define (->dbl x) (exact->inexact x))
+(register-class-statics! "Math"
+  (list (cons "sqrt" (lambda (x) (->dbl (sqrt x))))
+        (cons "pow" (lambda (a b) (->dbl (expt a b))))
+        (cons "floor" (lambda (x) (->dbl (floor x))))
+        (cons "ceil" (lambda (x) (->dbl (ceiling x))))
+        (cons "round" (lambda (x) (exact (floor (+ x 1/2)))))   ; JVM round-half-up -> long
+        (cons "abs" (lambda (x) (abs x)))
+        (cons "sin" (lambda (x) (->dbl (sin x)))) (cons "cos" (lambda (x) (->dbl (cos x))))
+        (cons "tan" (lambda (x) (->dbl (tan x)))) (cons "asin" (lambda (x) (->dbl (asin x))))
+        (cons "acos" (lambda (x) (->dbl (acos x)))) (cons "atan" (lambda (x) (->dbl (atan x))))
+        (cons "log" (lambda (x) (->dbl (log x)))) (cons "log10" (lambda (x) (->dbl (/ (log x) (log 10)))))
+        (cons "exp" (lambda (x) (->dbl (exp x))))
+        (cons "max" (lambda (a b) (if (> a b) a b))) (cons "min" (lambda (a b) (if (< a b) a b)))
+        (cons "signum" (lambda (x) (cond ((< x 0) -1.0) ((> x 0) 1.0) (else 0.0))))
+        (cons "PI" (->dbl (* 4 (atan 1)))) (cons "E" (->dbl (exp 1)))
+        (cons "random" (lambda args (random 1.0)))))
+
+;; Thread: real OS threads back futures/promises.
+;;  - sleep parks the calling thread for `ms` ms (a worker sleeping doesn't block
+;;    the parent).
+;;  - yield hands the CPU to another runnable thread (libc sched_yield).
+;;  - each thread carries an interrupt flag; interrupted (static) reads AND clears
+;;    the current thread's flag, matching the JVM. currentThread / .interrupt /
+;;    .isInterrupted are wired in io.ss, where the thread handle is built.
+
+;; Per-thread interrupt flag, lazily allocated so each OS thread gets its own box.
+;; A thread handle (from currentThread) captures this box, so .interrupt from
+;; another thread sets the target thread's flag.
+(define thread-interrupt-box (make-thread-parameter #f))
+(define (current-interrupt-box)
+  (or (thread-interrupt-box)
+      (let ((b (box #f))) (thread-interrupt-box b) b)))
+(define (clear-thread-interrupt!) (set-box! (current-interrupt-box) #f))
+
+;; libc sched_yield, resolved once; fall back to a zero-length park if the symbol
+;; isn't available.
+(define thread-yield!
+  (let ((fp #f) (tried? #f))
+    (lambda ()
+      (unless tried?
+        (set! tried? #t)
+        (set! fp (guard (e (#t #f))
+                   (load-shared-object #f)
+                   (foreign-procedure "sched_yield" () int))))
+      (if fp (fp) (sleep (make-time 'time-duration 0 0)))
+      jolt-nil)))
+
+(define thread-statics
+  (list (cons "sleep" (lambda (ms . _)
+                        (let* ((ms* (exact (floor ms)))
+                               (secs (quotient ms* 1000))
+                               (nanos (* (remainder ms* 1000) 1000000)))
+                          (sleep (make-time 'time-duration nanos secs)))
+                        jolt-nil))
+        (cons "yield" (lambda _ (thread-yield!)))
+        (cons "interrupted" (lambda _ (let* ((b (current-interrupt-box)) (v (unbox b)))
+                                        (set-box! b #f) (and v #t))))))
+(register-class-statics! "Thread" thread-statics)
+(register-class-statics! "java.lang.Thread" thread-statics)
+
+;; clojure.lang.LockingTransaction: jolt has no STM (no refs/dosync), so a
+;; transaction is never running. isRunning -> false.
+(register-class-statics! "LockingTransaction" (list (cons "isRunning" (lambda () #f))))
+(register-class-statics! "clojure.lang.LockingTransaction" (list (cons "isRunning" (lambda () #f))))
+
+;; clojure.lang.LazilyPersistentVector/createOwning: build a vector from an array
+;; (malli's -vmap fills an object-array then hands it over). jolt has no array
+;; ownership transfer, so copy the array's elements into a persistent vector.
+(define (lpv-create-owning arr) (apply jolt-vector (seq->list (jolt-seq arr))))
+(register-class-statics! "LazilyPersistentVector" (list (cons "createOwning" lpv-create-owning)))
+(register-class-statics! "clojure.lang.LazilyPersistentVector" (list (cons "createOwning" lpv-create-owning)))
+
+;; clojure.lang.PersistentArrayMap/createWithCheck: build a map from a [k v k v…]
+;; array, throwing on a duplicate key. malli's eager entry parser relies on the
+;; throw to report ::duplicate-keys, so a missing class would mis-fire on every
+;; map. Build the map and signal if a key collapsed (count*2 < array length).
+(define (pam-create-with-check arr)
+  (let ((items (seq->list (jolt-seq arr))))
+    (let loop ((xs items) (m (jolt-hash-map)))
+      (if (null? xs) m
+          (if (null? (cdr xs)) (error #f "PersistentArrayMap: odd key/value count")
+              (let ((k (car xs)))
+                (if (jolt-contains? m k) (error #f "Duplicate key")
+                    (loop (cddr xs) (jolt-assoc m k (cadr xs))))))))))
+(register-class-statics! "PersistentArrayMap" (list (cons "createWithCheck" pam-create-with-check)))
+(register-class-statics! "clojure.lang.PersistentArrayMap" (list (cons "createWithCheck" pam-create-with-check)))
+
+(define (now-millis)
+  (let ((t (current-time 'time-utc)))
+    (+ (* 1000 (time-second t)) (quotient (time-nanosecond t) 1000000))))
+
+;; clojure.core/current-time-ms — epoch milliseconds; backs the `time` macro.
+(def-var! "clojure.core" "current-time-ms" (lambda () (->num (now-millis))))
+(register-class-statics! "System"
+  (list (cons "currentTimeMillis" (lambda () (->num (now-millis))))
+        (cons "nanoTime" (lambda () (->num (* 1000000 (now-millis)))))
+        (cons "exit" (lambda args (exit (if (null? args) 0 (jnum->exact (car args))))))
+        ;; wrapped in lambdas: the helpers are defined below, resolved at call time.
+        (cons "getProperty" (lambda (k . d) (apply sys-get-property k d)))
+        (cons "setProperty" (lambda (k v) (sys-set-property k v)))
+        (cons "clearProperty" (lambda (k) (sys-clear-property k)))
+        (cons "getProperties" (lambda () (sys-properties-map)))
+        (cons "getenv" (lambda k (apply sys-getenv k)))))
+
+(register-class-statics! "Long"
+  (list (cons "MAX_VALUE" (->num 9223372036854775807))
+        (cons "MIN_VALUE" (->num -9223372036854775808))
+        (cons "parseLong" (lambda (s . r) (parse-int-or-throw s (if (null? r) 10 (jnum->exact (car r))) "parseLong")))
+        (cons "valueOf" (lambda (s . r) (parse-int-or-throw s (if (null? r) 10 (jnum->exact (car r))) "valueOf")))))
+
+(register-class-statics! "Integer"
+  (list (cons "MAX_VALUE" (->num 2147483647)) (cons "MIN_VALUE" (->num -2147483648))
+        (cons "valueOf" (lambda (x . r)
+                          (if (number? x) (->num x)
+                              (parse-int-or-throw x (if (null? r) 10 (jnum->exact (car r))) "valueOf"))))
+        (cons "parseInt" (lambda (x . r) (parse-int-or-throw x (if (null? r) 10 (jnum->exact (car r))) "parseInt")))))
+
+(register-class-statics! "Boolean"
+  (list (cons "parseBoolean" (lambda (s) (string=? "true" (ascii-string-down (if (string? s) s (jolt-str-render-one s))))))
+        (cons "TRUE" #t) (cons "FALSE" #f)))
+
+(register-class-ctor! "Double" ->double)
+(register-class-ctor! "Float" ->double)
+(register-class-statics! "Double"
+  (list (cons "parseDouble" parse-double-or-throw)
+        (cons "valueOf" ->double)
+        (cons "toString" (lambda (x) (jolt-str-render-one (->double x))))
+        (cons "isNaN" (lambda (x) (and (flonum? x) (nan? x))))
+        (cons "isInfinite" (lambda (x) (and (flonum? x) (infinite? x))))
+        (cons "MAX_VALUE" 1.7976931348623157e308) (cons "MIN_VALUE" 4.9e-324)
+        (cons "POSITIVE_INFINITY" +inf.0) (cons "NEGATIVE_INFINITY" -inf.0) (cons "NaN" +nan.0)))
+(register-class-statics! "Float"
+  (list (cons "parseFloat" parse-double-or-throw) (cons "valueOf" ->double)))
+
+;; Character: ASCII predicates (the engine is byte/ASCII oriented).
+(register-class-statics! "Character"
+  (list (cons "isUpperCase" (lambda (c) (let ((n (char-code c))) (and (>= n 65) (<= n 90)))))
+        (cons "isLowerCase" (lambda (c) (let ((n (char-code c))) (and (>= n 97) (<= n 122)))))
+        (cons "isDigit" (lambda (c) (let ((n (char-code c))) (and (>= n 48) (<= n 57)))))
+        (cons "isWhitespace" (lambda (c) (char<=? (integer->char (char-code c)) #\space)))))
+
+;; String/valueOf(Object): "null" for nil, else jolt's str semantics.
+;; String/format(fmt args…) / (locale fmt args…) -> the clojure.core format engine.
+(register-class-statics! "String"
+  (list (cons "valueOf" (lambda (x . _) (if (jolt-nil? x) "null" (jolt-str-render-one x))))
+        (cons "format" (lambda (a . rest)
+                         (if (and (jhost? a) (string=? (jhost-tag a) "locale"))
+                             (apply jolt-format (car rest) (cdr rest))
+                             (apply jolt-format a rest))))))
+
+;; ---- java.text.NumberFormat -------------------------------------------------
+;; A grouping decimal formatter (selmer number-format / cuerdas). state:
+;; #(grouping? min-frac max-frac). .format groups the integer part with commas.
+(define (nf-make grouping? minf maxf) (make-jhost "numberformat" (vector grouping? minf maxf)))
+(define (group-int-str s)               ; "1234567" -> "1,234,567"
+  (let* ((neg (and (> (string-length s) 0) (char=? (string-ref s 0) #\-)))
+         (digs (if neg (substring s 1 (string-length s)) s))
+         (n (string-length digs)) (out '()))
+    (let loop ((i 0))
+      (when (< i n)
+        (when (and (> i 0) (= 0 (modulo (- n i) 3))) (set! out (cons #\, out)))
+        (set! out (cons (string-ref digs i) out)) (loop (+ i 1))))
+    (string-append (if neg "-" "") (list->string (reverse out)))))
+(define (nf-format self x)
+  (let* ((grouping? (vector-ref (jhost-state self) 0))
+         (minf (vector-ref (jhost-state self) 1)) (maxf (vector-ref (jhost-state self) 2))
+         (neg (< x 0)) (ax (abs (exact->inexact x)))
+         (scale (expt 10 maxf))
+         (scaled (exact (round (* ax scale))))
+         (ipart (quotient scaled scale)) (fpart (remainder scaled scale))
+         (istr (number->string ipart))
+         (fstr0 (if (> maxf 0) (let ((s (number->string fpart)))
+                                 (string-append (make-string (max 0 (- maxf (string-length s))) #\0) s)) ""))
+         ;; trim trailing zeros down to minf
+         (fstr (let loop ((s fstr0)) (if (and (> (string-length s) minf)
+                                              (char=? (string-ref s (- (string-length s) 1)) #\0))
+                                         (loop (substring s 0 (- (string-length s) 1))) s))))
+    (string-append (if neg "-" "") (if grouping? (group-int-str istr) istr)
+                   (if (> (string-length fstr) 0) (string-append "." fstr) ""))))
+(register-host-methods! "numberformat"
+  (list (cons "format" (lambda (self n) (nf-format self n)))
+        (cons "setMaximumFractionDigits" (lambda (self d) (vector-set! (jhost-state self) 2 (jnum->exact d)) jolt-nil))
+        (cons "setMinimumFractionDigits" (lambda (self d) (vector-set! (jhost-state self) 1 (jnum->exact d)) jolt-nil))
+        (cons "setGroupingUsed" (lambda (self b) (vector-set! (jhost-state self) 0 (jolt-truthy? b)) jolt-nil))))
+(let ((nf-statics (list (cons "getInstance" (lambda _ (nf-make #t 0 3)))
+                        (cons "getNumberInstance" (lambda _ (nf-make #t 0 3)))
+                        (cons "getIntegerInstance" (lambda _ (nf-make #t 0 0))))))
+  (register-class-statics! "NumberFormat" nf-statics)
+  (register-class-statics! "java.text.NumberFormat" nf-statics))
+
+(register-class-statics! "Class"
+  ;; an array descriptor ("[C", "[I", …) is its own class token (so instance? and
+  ;; class compare equal); other names become a class jhost.
+  (list (cons "forName" (lambda (nm)
+                          (if (and (> (string-length nm) 0) (char=? (string-ref nm 0) #\[))
+                              nm
+                              (make-jhost "class" (list (cons 'name nm))))))))
+
+;; ---- System helpers (defined before use above via top-level order) ----------
+;; os.name reflects the actual platform (Chez's machine-type names it): a *osx
+;; machine is macOS, otherwise Linux. Code that branches on the OS (socket struct
+;; layout, path handling) needs the truth, not a fixed value.
+(define (substring-index needle hay)
+  (let ((nl (string-length needle)) (hl (string-length hay)))
+    (let loop ((i 0)) (cond ((> (+ i nl) hl) #f)
+                            ((string=? (substring hay i (+ i nl)) needle) i)
+                            (else (loop (+ i 1)))))))
+(define sys-os-name
+  (let ((m (symbol->string (machine-type))))
+    (cond ((or (substring-index "osx" m) (substring-index "macos" m)) "Mac OS X")
+          ((or (substring-index "nt" m) (substring-index "windows" m)) "Windows")
+          (else "Linux"))))
+;; runtime-settable system properties (System/setProperty). A set value wins over
+;; the built-in defaults below; clearProperty removes it.
+(define sys-prop-table (make-hashtable string-hash string=?))
+(define (sys-set-property k v)
+  (let ((prev (hashtable-ref sys-prop-table k jolt-nil)))
+    (hashtable-set! sys-prop-table k (if (string? v) v (jolt-str-render-one v)))
+    prev))
+(define (sys-clear-property k)
+  (let ((prev (hashtable-ref sys-prop-table k jolt-nil)))
+    (hashtable-delete! sys-prop-table k) prev))
+(define (sys-get-property k . dflt)
+  (let ((set-val (hashtable-ref sys-prop-table k #f)))
+    (cond (set-val set-val)
+          ((string=? k "os.name") sys-os-name)
+          ((string=? k "line.separator") "\n")
+          ((string=? k "file.separator") "/")
+          ((string=? k "path.separator") ":")
+          ((string=? k "user.dir") (or (getenv "PWD") "."))
+          ((string=? k "user.home") (or (getenv "HOME") ""))
+          ((string=? k "java.io.tmpdir") (or (getenv "TMPDIR") "/tmp"))
+          ((pair? dflt) (car dflt))
+          (else jolt-nil))))
+(define (sys-properties-map)
+  (jolt-hash-map "os.name" sys-os-name "line.separator" "\n" "file.separator" "/"
+                 "user.dir" (or (getenv "PWD") ".") "user.home" (or (getenv "HOME") "")
+                 "java.io.tmpdir" (or (getenv "TMPDIR") "/tmp")))
+
+;; full environment as an alist of (name . value), via spawning `env`.
+(define (all-env-pairs)
+  (call-with-values
+    (lambda () (open-process-ports "env" (buffer-mode block) (native-transcoder)))
+    (lambda (stdin stdout stderr pid)
+      (let loop ((acc '()))
+        (let ((l (get-line stdout)))
+          (if (eof-object? l) (reverse acc)
+              (let ((eq (let scan ((i 0)) (cond ((= i (string-length l)) #f)
+                                                ((char=? (string-ref l i) #\=) i)
+                                                (else (scan (+ i 1)))))))
+                (loop (if eq (cons (cons (substring l 0 eq) (substring l (+ eq 1) (string-length l))) acc) acc)))))))))
+;; JOLT_BAKE_ENV_ALLOWLIST: when set, only the listed comma-separated
+;; names are served; unset (the normal case) reads are live and unfiltered.
+(define (env-allowlist)
+  (let ((a (getenv "JOLT_BAKE_ENV_ALLOWLIST")))
+    (and a (map str-trim (str-literal-split a ",")))))
+(define (sys-getenv . k)
+  (let ((allow (env-allowlist)))
+    (if (null? k)
+        (apply jolt-hash-map
+          (let loop ((ps (all-env-pairs)) (acc '()))
+            (cond ((null? ps) (reverse acc))
+                  ((and allow (not (member (caar ps) allow))) (loop (cdr ps) acc))
+                  (else (loop (cdr ps) (cons (cdar ps) (cons (caar ps) acc)))))))
+        (let ((name (car k)))
+          (if (and allow (not (member name allow))) jolt-nil
+              (let ((v (getenv name))) (if v v jolt-nil)))))))
+
+;; ---- StringBuilder ----------------------------------------------------------
+;; state: a box (1-vector) holding the accumulated string.
+(define (sb-str self) (vector-ref (jhost-state self) 0))
+(define (sb-set! self s) (vector-set! (jhost-state self) 0 s))
+(define (render-piece x)
+  (cond ((jolt-nil? x) "null") ((char? x) (string x)) ((string? x) x)
+        (else (jolt-str-render-one x))))
+;; (Object.) — a fresh value with distinct identity (libraries use it as a lock
+;; or a unique sentinel). Each call returns a new jhost so identical?/= separate.
+(register-class-ctor! "Object" (lambda _ (make-jhost "object" (vector))))
+

host/chez/host-static.ss

@@ -139,792 +139,3 @@
                                (if (string? s) s (jolt-str-render-one s)) "\""))))
 (define (->double x) (if (number? x) (exact->inexact x) (parse-double-or-throw x)))
 
-;; ---- java.lang statics ------------------------------------------------------
-;; java.lang.Math: sqrt/pow/floor/ceil/trig/log/exp always return a DOUBLE on the
-;; JVM (Chez's sqrt/expt return EXACT for exact args, e.g. (sqrt 9) -> 3), so coerce
-;; to flonum. round -> long (exact); abs/max/min preserve the argument's type.
-(define (->dbl x) (exact->inexact x))
-(register-class-statics! "Math"
-  (list (cons "sqrt" (lambda (x) (->dbl (sqrt x))))
-        (cons "pow" (lambda (a b) (->dbl (expt a b))))
-        (cons "floor" (lambda (x) (->dbl (floor x))))
-        (cons "ceil" (lambda (x) (->dbl (ceiling x))))
-        (cons "round" (lambda (x) (exact (floor (+ x 1/2)))))   ; JVM round-half-up -> long
-        (cons "abs" (lambda (x) (abs x)))
-        (cons "sin" (lambda (x) (->dbl (sin x)))) (cons "cos" (lambda (x) (->dbl (cos x))))
-        (cons "tan" (lambda (x) (->dbl (tan x)))) (cons "asin" (lambda (x) (->dbl (asin x))))
-        (cons "acos" (lambda (x) (->dbl (acos x)))) (cons "atan" (lambda (x) (->dbl (atan x))))
-        (cons "log" (lambda (x) (->dbl (log x)))) (cons "log10" (lambda (x) (->dbl (/ (log x) (log 10)))))
-        (cons "exp" (lambda (x) (->dbl (exp x))))
-        (cons "max" (lambda (a b) (if (> a b) a b))) (cons "min" (lambda (a b) (if (< a b) a b)))
-        (cons "signum" (lambda (x) (cond ((< x 0) -1.0) ((> x 0) 1.0) (else 0.0))))
-        (cons "PI" (->dbl (* 4 (atan 1)))) (cons "E" (->dbl (exp 1)))
-        (cons "random" (lambda args (random 1.0)))))
-
-;; Thread: real OS threads back futures/promises.
-;;  - sleep parks the calling thread for `ms` ms (a worker sleeping doesn't block
-;;    the parent).
-;;  - yield hands the CPU to another runnable thread (libc sched_yield).
-;;  - each thread carries an interrupt flag; interrupted (static) reads AND clears
-;;    the current thread's flag, matching the JVM. currentThread / .interrupt /
-;;    .isInterrupted are wired in io.ss, where the thread handle is built.
-
-;; Per-thread interrupt flag, lazily allocated so each OS thread gets its own box.
-;; A thread handle (from currentThread) captures this box, so .interrupt from
-;; another thread sets the target thread's flag.
-(define thread-interrupt-box (make-thread-parameter #f))
-(define (current-interrupt-box)
-  (or (thread-interrupt-box)
-      (let ((b (box #f))) (thread-interrupt-box b) b)))
-(define (clear-thread-interrupt!) (set-box! (current-interrupt-box) #f))
-
-;; libc sched_yield, resolved once; fall back to a zero-length park if the symbol
-;; isn't available.
-(define thread-yield!
-  (let ((fp #f) (tried? #f))
-    (lambda ()
-      (unless tried?
-        (set! tried? #t)
-        (set! fp (guard (e (#t #f))
-                   (load-shared-object #f)
-                   (foreign-procedure "sched_yield" () int))))
-      (if fp (fp) (sleep (make-time 'time-duration 0 0)))
-      jolt-nil)))
-
-(define thread-statics
-  (list (cons "sleep" (lambda (ms . _)
-                        (let* ((ms* (exact (floor ms)))
-                               (secs (quotient ms* 1000))
-                               (nanos (* (remainder ms* 1000) 1000000)))
-                          (sleep (make-time 'time-duration nanos secs)))
-                        jolt-nil))
-        (cons "yield" (lambda _ (thread-yield!)))
-        (cons "interrupted" (lambda _ (let* ((b (current-interrupt-box)) (v (unbox b)))
-                                        (set-box! b #f) (and v #t))))))
-(register-class-statics! "Thread" thread-statics)
-(register-class-statics! "java.lang.Thread" thread-statics)
-
-;; clojure.lang.LockingTransaction: jolt has no STM (no refs/dosync), so a
-;; transaction is never running. isRunning -> false.
-(register-class-statics! "LockingTransaction" (list (cons "isRunning" (lambda () #f))))
-(register-class-statics! "clojure.lang.LockingTransaction" (list (cons "isRunning" (lambda () #f))))
-
-;; clojure.lang.LazilyPersistentVector/createOwning: build a vector from an array
-;; (malli's -vmap fills an object-array then hands it over). jolt has no array
-;; ownership transfer, so copy the array's elements into a persistent vector.
-(define (lpv-create-owning arr) (apply jolt-vector (seq->list (jolt-seq arr))))
-(register-class-statics! "LazilyPersistentVector" (list (cons "createOwning" lpv-create-owning)))
-(register-class-statics! "clojure.lang.LazilyPersistentVector" (list (cons "createOwning" lpv-create-owning)))
-
-;; clojure.lang.PersistentArrayMap/createWithCheck: build a map from a [k v k v…]
-;; array, throwing on a duplicate key. malli's eager entry parser relies on the
-;; throw to report ::duplicate-keys, so a missing class would mis-fire on every
-;; map. Build the map and signal if a key collapsed (count*2 < array length).
-(define (pam-create-with-check arr)
-  (let ((items (seq->list (jolt-seq arr))))
-    (let loop ((xs items) (m (jolt-hash-map)))
-      (if (null? xs) m
-          (if (null? (cdr xs)) (error #f "PersistentArrayMap: odd key/value count")
-              (let ((k (car xs)))
-                (if (jolt-contains? m k) (error #f "Duplicate key")
-                    (loop (cddr xs) (jolt-assoc m k (cadr xs))))))))))
-(register-class-statics! "PersistentArrayMap" (list (cons "createWithCheck" pam-create-with-check)))
-(register-class-statics! "clojure.lang.PersistentArrayMap" (list (cons "createWithCheck" pam-create-with-check)))
-
-(define (now-millis)
-  (let ((t (current-time 'time-utc)))
-    (+ (* 1000 (time-second t)) (quotient (time-nanosecond t) 1000000))))
-
-;; clojure.core/current-time-ms — epoch milliseconds; backs the `time` macro.
-(def-var! "clojure.core" "current-time-ms" (lambda () (->num (now-millis))))
-(register-class-statics! "System"
-  (list (cons "currentTimeMillis" (lambda () (->num (now-millis))))
-        (cons "nanoTime" (lambda () (->num (* 1000000 (now-millis)))))
-        (cons "exit" (lambda args (exit (if (null? args) 0 (jnum->exact (car args))))))
-        ;; wrapped in lambdas: the helpers are defined below, resolved at call time.
-        (cons "getProperty" (lambda (k . d) (apply sys-get-property k d)))
-        (cons "setProperty" (lambda (k v) (sys-set-property k v)))
-        (cons "clearProperty" (lambda (k) (sys-clear-property k)))
-        (cons "getProperties" (lambda () (sys-properties-map)))
-        (cons "getenv" (lambda k (apply sys-getenv k)))))
-
-(register-class-statics! "Long"
-  (list (cons "MAX_VALUE" (->num 9223372036854775807))
-        (cons "MIN_VALUE" (->num -9223372036854775808))
-        (cons "parseLong" (lambda (s . r) (parse-int-or-throw s (if (null? r) 10 (jnum->exact (car r))) "parseLong")))
-        (cons "valueOf" (lambda (s . r) (parse-int-or-throw s (if (null? r) 10 (jnum->exact (car r))) "valueOf")))))
-
-(register-class-statics! "Integer"
-  (list (cons "MAX_VALUE" (->num 2147483647)) (cons "MIN_VALUE" (->num -2147483648))
-        (cons "valueOf" (lambda (x . r)
-                          (if (number? x) (->num x)
-                              (parse-int-or-throw x (if (null? r) 10 (jnum->exact (car r))) "valueOf"))))
-        (cons "parseInt" (lambda (x . r) (parse-int-or-throw x (if (null? r) 10 (jnum->exact (car r))) "parseInt")))))
-
-(register-class-statics! "Boolean"
-  (list (cons "parseBoolean" (lambda (s) (string=? "true" (ascii-string-down (if (string? s) s (jolt-str-render-one s))))))
-        (cons "TRUE" #t) (cons "FALSE" #f)))
-
-(register-class-ctor! "Double" ->double)
-(register-class-ctor! "Float" ->double)
-(register-class-statics! "Double"
-  (list (cons "parseDouble" parse-double-or-throw)
-        (cons "valueOf" ->double)
-        (cons "toString" (lambda (x) (jolt-str-render-one (->double x))))
-        (cons "isNaN" (lambda (x) (and (flonum? x) (nan? x))))
-        (cons "isInfinite" (lambda (x) (and (flonum? x) (infinite? x))))
-        (cons "MAX_VALUE" 1.7976931348623157e308) (cons "MIN_VALUE" 4.9e-324)
-        (cons "POSITIVE_INFINITY" +inf.0) (cons "NEGATIVE_INFINITY" -inf.0) (cons "NaN" +nan.0)))
-(register-class-statics! "Float"
-  (list (cons "parseFloat" parse-double-or-throw) (cons "valueOf" ->double)))
-
-;; Character: ASCII predicates (the engine is byte/ASCII oriented).
-(register-class-statics! "Character"
-  (list (cons "isUpperCase" (lambda (c) (let ((n (char-code c))) (and (>= n 65) (<= n 90)))))
-        (cons "isLowerCase" (lambda (c) (let ((n (char-code c))) (and (>= n 97) (<= n 122)))))
-        (cons "isDigit" (lambda (c) (let ((n (char-code c))) (and (>= n 48) (<= n 57)))))
-        (cons "isWhitespace" (lambda (c) (char<=? (integer->char (char-code c)) #\space)))))
-
-;; String/valueOf(Object): "null" for nil, else jolt's str semantics.
-;; String/format(fmt args…) / (locale fmt args…) -> the clojure.core format engine.
-(register-class-statics! "String"
-  (list (cons "valueOf" (lambda (x . _) (if (jolt-nil? x) "null" (jolt-str-render-one x))))
-        (cons "format" (lambda (a . rest)
-                         (if (and (jhost? a) (string=? (jhost-tag a) "locale"))
-                             (apply jolt-format (car rest) (cdr rest))
-                             (apply jolt-format a rest))))))
-
-;; ---- java.text.NumberFormat -------------------------------------------------
-;; A grouping decimal formatter (selmer number-format / cuerdas). state:
-;; #(grouping? min-frac max-frac). .format groups the integer part with commas.
-(define (nf-make grouping? minf maxf) (make-jhost "numberformat" (vector grouping? minf maxf)))
-(define (group-int-str s)               ; "1234567" -> "1,234,567"
-  (let* ((neg (and (> (string-length s) 0) (char=? (string-ref s 0) #\-)))
-         (digs (if neg (substring s 1 (string-length s)) s))
-         (n (string-length digs)) (out '()))
-    (let loop ((i 0))
-      (when (< i n)
-        (when (and (> i 0) (= 0 (modulo (- n i) 3))) (set! out (cons #\, out)))
-        (set! out (cons (string-ref digs i) out)) (loop (+ i 1))))
-    (string-append (if neg "-" "") (list->string (reverse out)))))
-(define (nf-format self x)
-  (let* ((grouping? (vector-ref (jhost-state self) 0))
-         (minf (vector-ref (jhost-state self) 1)) (maxf (vector-ref (jhost-state self) 2))
-         (neg (< x 0)) (ax (abs (exact->inexact x)))
-         (scale (expt 10 maxf))
-         (scaled (exact (round (* ax scale))))
-         (ipart (quotient scaled scale)) (fpart (remainder scaled scale))
-         (istr (number->string ipart))
-         (fstr0 (if (> maxf 0) (let ((s (number->string fpart)))
-                                 (string-append (make-string (max 0 (- maxf (string-length s))) #\0) s)) ""))
-         ;; trim trailing zeros down to minf
-         (fstr (let loop ((s fstr0)) (if (and (> (string-length s) minf)
-                                              (char=? (string-ref s (- (string-length s) 1)) #\0))
-                                         (loop (substring s 0 (- (string-length s) 1))) s))))
-    (string-append (if neg "-" "") (if grouping? (group-int-str istr) istr)
-                   (if (> (string-length fstr) 0) (string-append "." fstr) ""))))
-(register-host-methods! "numberformat"
-  (list (cons "format" (lambda (self n) (nf-format self n)))
-        (cons "setMaximumFractionDigits" (lambda (self d) (vector-set! (jhost-state self) 2 (jnum->exact d)) jolt-nil))
-        (cons "setMinimumFractionDigits" (lambda (self d) (vector-set! (jhost-state self) 1 (jnum->exact d)) jolt-nil))
-        (cons "setGroupingUsed" (lambda (self b) (vector-set! (jhost-state self) 0 (jolt-truthy? b)) jolt-nil))))
-(register-class-statics! "NumberFormat"
-  (list (cons "getInstance" (lambda _ (nf-make #t 0 3)))
-        (cons "getNumberInstance" (lambda _ (nf-make #t 0 3)))
-        (cons "getIntegerInstance" (lambda _ (nf-make #t 0 0)))))
-(register-class-statics! "java.text.NumberFormat"
-  (list (cons "getInstance" (lambda _ (nf-make #t 0 3)))
-        (cons "getNumberInstance" (lambda _ (nf-make #t 0 3)))
-        (cons "getIntegerInstance" (lambda _ (nf-make #t 0 0)))))
-
-(register-class-statics! "Class"
-  ;; an array descriptor ("[C", "[I", …) is its own class token (so instance? and
-  ;; class compare equal); other names become a class jhost.
-  (list (cons "forName" (lambda (nm)
-                          (if (and (> (string-length nm) 0) (char=? (string-ref nm 0) #\[))
-                              nm
-                              (make-jhost "class" (list (cons 'name nm))))))))
-
-;; ---- System helpers (defined before use above via top-level order) ----------
-;; os.name reflects the actual platform (Chez's machine-type names it): a *osx
-;; machine is macOS, otherwise Linux. Code that branches on the OS (socket struct
-;; layout, path handling) needs the truth, not a fixed value.
-(define (substring-index needle hay)
-  (let ((nl (string-length needle)) (hl (string-length hay)))
-    (let loop ((i 0)) (cond ((> (+ i nl) hl) #f)
-                            ((string=? (substring hay i (+ i nl)) needle) i)
-                            (else (loop (+ i 1)))))))
-(define sys-os-name
-  (let ((m (symbol->string (machine-type))))
-    (cond ((or (substring-index "osx" m) (substring-index "macos" m)) "Mac OS X")
-          ((or (substring-index "nt" m) (substring-index "windows" m)) "Windows")
-          (else "Linux"))))
-;; runtime-settable system properties (System/setProperty). A set value wins over
-;; the built-in defaults below; clearProperty removes it.
-(define sys-prop-table (make-hashtable string-hash string=?))
-(define (sys-set-property k v)
-  (let ((prev (hashtable-ref sys-prop-table k jolt-nil)))
-    (hashtable-set! sys-prop-table k (if (string? v) v (jolt-str-render-one v)))
-    prev))
-(define (sys-clear-property k)
-  (let ((prev (hashtable-ref sys-prop-table k jolt-nil)))
-    (hashtable-delete! sys-prop-table k) prev))
-(define (sys-get-property k . dflt)
-  (let ((set-val (hashtable-ref sys-prop-table k #f)))
-    (cond (set-val set-val)
-          ((string=? k "os.name") sys-os-name)
-          ((string=? k "line.separator") "\n")
-          ((string=? k "file.separator") "/")
-          ((string=? k "path.separator") ":")
-          ((string=? k "user.dir") (or (getenv "PWD") "."))
-          ((string=? k "user.home") (or (getenv "HOME") ""))
-          ((string=? k "java.io.tmpdir") (or (getenv "TMPDIR") "/tmp"))
-          ((pair? dflt) (car dflt))
-          (else jolt-nil))))
-(define (sys-properties-map)
-  (jolt-hash-map "os.name" sys-os-name "line.separator" "\n" "file.separator" "/"
-                 "user.dir" (or (getenv "PWD") ".") "user.home" (or (getenv "HOME") "")
-                 "java.io.tmpdir" (or (getenv "TMPDIR") "/tmp")))
-
-;; full environment as an alist of (name . value), via spawning `env`.
-(define (all-env-pairs)
-  (call-with-values
-    (lambda () (open-process-ports "env" (buffer-mode block) (native-transcoder)))
-    (lambda (stdin stdout stderr pid)
-      (let loop ((acc '()))
-        (let ((l (get-line stdout)))
-          (if (eof-object? l) (reverse acc)
-              (let ((eq (let scan ((i 0)) (cond ((= i (string-length l)) #f)
-                                                ((char=? (string-ref l i) #\=) i)
-                                                (else (scan (+ i 1)))))))
-                (loop (if eq (cons (cons (substring l 0 eq) (substring l (+ eq 1) (string-length l))) acc) acc)))))))))
-;; JOLT_BAKE_ENV_ALLOWLIST: when set, only the listed comma-separated
-;; names are served; unset (the normal case) reads are live and unfiltered.
-(define (env-allowlist)
-  (let ((a (getenv "JOLT_BAKE_ENV_ALLOWLIST")))
-    (and a (map str-trim (str-literal-split a ",")))))
-(define (sys-getenv . k)
-  (let ((allow (env-allowlist)))
-    (if (null? k)
-        (apply jolt-hash-map
-          (let loop ((ps (all-env-pairs)) (acc '()))
-            (cond ((null? ps) (reverse acc))
-                  ((and allow (not (member (caar ps) allow))) (loop (cdr ps) acc))
-                  (else (loop (cdr ps) (cons (cdar ps) (cons (caar ps) acc)))))))
-        (let ((name (car k)))
-          (if (and allow (not (member name allow))) jolt-nil
-              (let ((v (getenv name))) (if v v jolt-nil)))))))
-
-;; ---- StringBuilder ----------------------------------------------------------
-;; state: a box (1-vector) holding the accumulated string.
-(define (sb-str self) (vector-ref (jhost-state self) 0))
-(define (sb-set! self s) (vector-set! (jhost-state self) 0 s))
-(define (render-piece x)
-  (cond ((jolt-nil? x) "null") ((char? x) (string x)) ((string? x) x)
-        (else (jolt-str-render-one x))))
-;; (Object.) — a fresh value with distinct identity (libraries use it as a lock
-;; or a unique sentinel). Each call returns a new jhost so identical?/= separate.
-(register-class-ctor! "Object" (lambda _ (make-jhost "object" (vector))))
-
-;; ---- java.util.ArrayList ----------------------------------------------------
-;; A mutable list backed by a Scheme list in a box. medley's stateful transducers
-;; (window / partition-between) build one with .add / .size / .toArray / .clear /
-;; .remove. (ArrayList.) | (ArrayList. n) | (ArrayList. coll).
-(define (al-list self) (vector-ref (jhost-state self) 0))
-(define (al-set! self xs) (vector-set! (jhost-state self) 0 xs))
-(define (make-arraylist xs) (make-jhost "arraylist" (vector xs)))
-(register-class-ctor! "ArrayList"
-  (lambda args
-    (cond ((null? args) (make-arraylist '()))
-          ((number? (car args)) (make-arraylist '()))   ; initial capacity, ignored
-          (else (make-arraylist (seq->list (jolt-seq (car args))))))))
-(register-class-ctor! "java.util.ArrayList"
-  (lambda args
-    (cond ((null? args) (make-arraylist '()))
-          ((number? (car args)) (make-arraylist '()))
-          (else (make-arraylist (seq->list (jolt-seq (car args))))))))
-(define (al-remove-at xs i)
-  (let loop ((xs xs) (i i) (acc '()))
-    (cond ((null? xs) (reverse acc))
-          ((= i 0) (append (reverse acc) (cdr xs)))
-          (else (loop (cdr xs) (- i 1) (cons (car xs) acc))))))
-(register-host-methods! "arraylist"
-  (list
-    (cons "add" (lambda (self . a)
-                  ;; (.add x) -> append+true; (.add i x) -> insert at i, returns nil.
-                  (if (= 1 (length a))
-                      (begin (al-set! self (append (al-list self) (list (car a)))) #t)
-                      (let ((i (jnum->exact (car a))) (x (cadr a)) (xs (al-list self)))
-                        (al-set! self (append (list-head xs i) (list x) (list-tail xs i))) jolt-nil))))
-    (cons "add!" (lambda (self x) (al-set! self (append (al-list self) (list x))) #t))
-    (cons "get" (lambda (self i) (list-ref (al-list self) (jnum->exact i))))
-    (cons "set" (lambda (self i x)
-                  (let* ((xs (al-list self)) (idx (jnum->exact i)) (old (list-ref xs idx)))
-                    (al-set! self (append (list-head xs idx) (list x) (list-tail xs (+ idx 1)))) old)))
-    (cons "size" (lambda (self) (->num (length (al-list self)))))
-    (cons "isEmpty" (lambda (self) (null? (al-list self))))
-    (cons "remove" (lambda (self i)
-                     (let* ((xs (al-list self)) (idx (jnum->exact i)) (old (list-ref xs idx)))
-                       (al-set! self (al-remove-at xs idx)) old)))
-    (cons "clear" (lambda (self) (al-set! self '()) jolt-nil))
-    (cons "contains" (lambda (self x) (and (memp (lambda (e) (jolt=2 e x)) (al-list self)) #t)))
-    (cons "toArray" (lambda (self . _) (apply jolt-vector (al-list self))))
-    (cons "iterator" (lambda (self) (make-jiterator (list->cseq (al-list self)))))
-    (cons "toString" (lambda (self) (jolt-pr-str (list->cseq (al-list self)))))))
-
-(register-class-ctor! "StringBuilder"
-  (lambda args (make-jhost "string-builder"
-    ;; a numeric first arg is a CAPACITY hint, not content.
-    (vector (if (and (pair? args) (not (number? (car args)))) (render-piece (car args)) "")))))
-(register-host-methods! "string-builder"
-  (list (cons "append" (lambda (self x) (sb-set! self (string-append (sb-str self) (render-piece x))) self))
-        (cons "toString" (lambda (self) (sb-str self)))
-        (cons "length" (lambda (self) (->num (string-length (sb-str self)))))
-        (cons "charAt" (lambda (self i) (string-ref (sb-str self) (jnum->exact i))))
-        (cons "setLength" (lambda (self n)
-                            (let ((cur (sb-str self)) (n (jnum->exact n)))
-                              (sb-set! self (if (< n (string-length cur))
-                                                (substring cur 0 n)
-                                                (string-append cur (make-string (- n (string-length cur)) #\nul)))))
-                            jolt-nil))))
-
-;; ---- StringWriter -----------------------------------------------------------
-;; Writer.write(int) writes the CHAR for that code; append(char) appends the char.
-(define (writer-piece x) (if (number? x) (string (integer->char (jnum->exact x))) (render-piece x)))
-(register-class-ctor! "StringWriter" (lambda args (make-jhost "writer" (vector ""))))
-(register-host-methods! "writer"
-  (list (cons "write" (lambda (self x) (sb-set! self (string-append (sb-str self) (writer-piece x))) jolt-nil))
-        (cons "append" (lambda (self x) (sb-set! self (string-append (sb-str self) (render-piece x))) self))
-        (cons "flush" (lambda (self) jolt-nil))
-        (cons "close" (lambda (self) jolt-nil))
-        (cons "toString" (lambda (self) (sb-str self)))))
-
-;; a file-backed writer (clojure.java.io/writer of a File/path): accumulates like
-;; StringWriter, then persists to the path on flush/close, so
-;; (with-open [w (io/writer "f")] (.write w …)) writes the file. State #(path buf).
-(define (fw-path self) (vector-ref (jhost-state self) 0))
-(define (fw-buf self) (vector-ref (jhost-state self) 1))
-(define (fw-append! self s) (vector-set! (jhost-state self) 1 (string-append (fw-buf self) s)))
-(define (fw-flush! self) (jolt-spit (fw-path self) (fw-buf self)))  ; jolt-spit: io.ss
-(register-host-methods! "file-writer"
-  (list (cons "write" (lambda (self x) (fw-append! self (writer-piece x)) jolt-nil))
-        (cons "append" (lambda (self x) (fw-append! self (render-piece x)) self))
-        (cons "flush" (lambda (self) (fw-flush! self) jolt-nil))
-        (cons "close" (lambda (self) (fw-flush! self) jolt-nil))
-        (cons "toString" (lambda (self) (fw-buf self)))))
-
-;; a writer over a real Chez port — the values *out* / *err* hold. write/append
-;; push to the port (so (.write *out* s) and (binding [*out* *err*] …) work);
-;; it isn't a buffer, so toString is empty. Lets libraries that touch *out*/*err*
-;; (tools.logging, selmer) compile and run.
-(register-host-methods! "port-writer"
-  (list (cons "write" (lambda (self x) (display (writer-piece x) (vector-ref (jhost-state self) 0)) jolt-nil))
-        (cons "append" (lambda (self x) (display (render-piece x) (vector-ref (jhost-state self) 0)) self))
-        (cons "flush" (lambda (self) (flush-output-port (vector-ref (jhost-state self) 0)) jolt-nil))
-        (cons "close" (lambda (self) jolt-nil))
-        (cons "toString" (lambda (self) ""))))
-(def-var! "clojure.core" "*out*" (make-jhost "port-writer" (vector (current-output-port))))
-(def-var! "clojure.core" "*err*" (make-jhost "port-writer" (vector (current-error-port))))
-
-;; ---- java.util.HashMap ------------------------------------------------------
-;; A mutable map keyed by jolt values (jolt-hash / jolt=2). State #(chez-hashtable).
-;; Constructors: () | (capacity) | (capacity load-factor) [sizing args ignored] |
-;; (Map m) [copy]. Enough of the Map surface for libraries that build a fast lookup
-;; (malli's fast-registry: (doto (HashMap. 1024 0.25) (.putAll m)) then .get).
-(define (hm-hash k) (let ((h (jolt-hash k)))
-                      (bitwise-and (if (and (integer? h) (exact? h)) (abs h) 0) #x3FFFFFFF)))
-(define (hm-tbl self) (vector-ref (jhost-state self) 0))
-(define (hm-hashmap? x) (and (jhost? x) (string=? (jhost-tag x) "hashmap")))
-(define (hm-copy-into! ht src)            ; src: a jolt map or another hashmap
-  (if (hm-hashmap? src)
-      (vector-for-each (lambda (k) (hashtable-set! ht k (hashtable-ref (hm-tbl src) k jolt-nil)))
-                       (hashtable-keys (hm-tbl src)))
-      (for-each (lambda (e) (hashtable-set! ht (jolt-nth e 0) (jolt-nth e 1)))
-                (seq->list (jolt-seq src)))))
-(register-class-ctor! "HashMap"
-  (lambda args
-    (let ((ht (make-hashtable hm-hash jolt=2)))
-      (when (and (pair? args) (or (pmap? (car args)) (hm-hashmap? (car args))))
-        (hm-copy-into! ht (car args)))
-      (make-jhost "hashmap" (vector ht)))))
-(define (hm->pmap self)
-  (let ((m (jolt-hash-map)))
-    (vector-for-each (lambda (k) (set! m (jolt-assoc m k (hashtable-ref (hm-tbl self) k jolt-nil))))
-                     (hashtable-keys (hm-tbl self)))
-    m))
-(register-host-methods! "hashmap"
-  (list (cons "put" (lambda (self k v) (let ((old (hashtable-ref (hm-tbl self) k jolt-nil)))
-                                          (hashtable-set! (hm-tbl self) k v) old)))
-        (cons "get" (lambda (self k) (hashtable-ref (hm-tbl self) k jolt-nil)))
-        (cons "getOrDefault" (lambda (self k d) (hashtable-ref (hm-tbl self) k d)))
-        (cons "containsKey" (lambda (self k) (if (hashtable-contains? (hm-tbl self) k) #t #f)))
-        (cons "containsValue" (lambda (self v)
-          (let ((found #f))
-            (vector-for-each (lambda (k) (when (jolt=2 v (hashtable-ref (hm-tbl self) k jolt-nil)) (set! found #t)))
-                             (hashtable-keys (hm-tbl self))) found)))
-        (cons "size" (lambda (self) (hashtable-size (hm-tbl self))))
-        (cons "isEmpty" (lambda (self) (= 0 (hashtable-size (hm-tbl self)))))
-        (cons "remove" (lambda (self k) (let ((old (hashtable-ref (hm-tbl self) k jolt-nil)))
-                                           (hashtable-delete! (hm-tbl self) k) old)))
-        (cons "clear" (lambda (self) (hashtable-clear! (hm-tbl self)) jolt-nil))
-        (cons "putAll" (lambda (self m) (hm-copy-into! (hm-tbl self) m) jolt-nil))
-        (cons "keySet" (lambda (self) (apply jolt-hash-set (vector->list (hashtable-keys (hm-tbl self))))))
-        (cons "values" (lambda (self) (apply jolt-vector
-                          (map (lambda (k) (hashtable-ref (hm-tbl self) k jolt-nil))
-                               (vector->list (hashtable-keys (hm-tbl self)))))))
-        (cons "entrySet" (lambda (self) (jolt-seq (hm->pmap self))))
-        (cons "toString" (lambda (self) (jolt-pr-str (hm->pmap self))))))
-
-;; ---- StringReader -----------------------------------------------------------
-;; state: a vector #(string pos marked).
-(register-class-ctor! "StringReader"
-  ;; src is a String or a char[] ((StringReader. (char-array s)) — selmer's parser
-  ;; reads templates this way); a char-array becomes the string of its chars.
-  (lambda (src . _)
-    (make-jhost "string-reader"
-      (vector (cond ((string? src) src)
-                    ((jolt-array? src) (apply string-append (map jolt-str-render-one (seq->list (jolt-seq src)))))
-                    (else (jolt-str-render-one src)))
-              0 0))))
-(define (sr-s self) (vector-ref (jhost-state self) 0))
-(define (sr-pos self) (vector-ref (jhost-state self) 1))
-(define (sr-pos! self p) (vector-set! (jhost-state self) 1 p))
-(register-host-methods! "string-reader"
-  (list (cons "read" (lambda (self)
-                       (let ((s (sr-s self)) (p (sr-pos self)))
-                         (if (>= p (string-length s)) -1   ; EOF -> exact int -1 (= JVM)
-                             (begin (sr-pos! self (+ p 1)) (->num (char->integer (string-ref s p))))))))
-        (cons "mark" (lambda (self . _) (vector-set! (jhost-state self) 2 (sr-pos self)) jolt-nil))
-        (cons "reset" (lambda (self) (sr-pos! self (vector-ref (jhost-state self) 2)) jolt-nil))
-        (cons "skip" (lambda (self n) (let ((n (jnum->exact n)))
-                                        (sr-pos! self (min (string-length (sr-s self)) (+ (sr-pos self) n))) (->num n))))
-        ;; readLine: the next line without its terminator (\n or \r\n), nil at EOF —
-        ;; what line-seq drives over a BufferedReader.
-        (cons "readLine"
-          (lambda (self)
-            (let ((s (sr-s self)) (p (sr-pos self)) (len (string-length (sr-s self))))
-              (if (>= p len) jolt-nil
-                  (let scan ((i p))
-                    (cond
-                      ((>= i len) (sr-pos! self len) (substring s p len))
-                      ((char=? (string-ref s i) #\newline)
-                       (sr-pos! self (+ i 1))
-                       (substring s p (if (and (> i p) (char=? (string-ref s (- i 1)) #\return)) (- i 1) i)))
-                      (else (scan (+ i 1)))))))))
-        (cons "close" (lambda (self) jolt-nil))))
-
-;; ---- PushbackReader ---------------------------------------------------------
-;; state: a vector #(wrapped-reader pushed-list)
-(register-class-ctor! "PushbackReader"
-  (lambda (rdr . _) (make-jhost "pushback-reader" (vector rdr '()))))
-(define (read-unit r)        ; read one code unit (flonum) from any reader, -1 at EOF
-  (record-method-dispatch r "read" jolt-nil))
-(register-host-methods! "pushback-reader"
-  (list (cons "read" (lambda (self)
-                       (let ((pushed (vector-ref (jhost-state self) 1)))
-                         (if (pair? pushed)
-                             (begin (vector-set! (jhost-state self) 1 (cdr pushed)) (car pushed))
-                             (read-unit (vector-ref (jhost-state self) 0))))))
-        (cons "unread" (lambda (self ch)
-                         (vector-set! (jhost-state self) 1
-                           (cons (if (char? ch) (->num (char->integer ch)) ch) (vector-ref (jhost-state self) 1)))
-                         jolt-nil))
-        (cons "close" (lambda (self) jolt-nil))))
-
-;; ---- HashMap ----------------------------------------------------------------
-;; state: a box holding an alist of (k . v), jolt= keyed.
-(define (hm-alist self) (vector-ref (jhost-state self) 0))
-(define (hm-set! self al) (vector-set! (jhost-state self) 0 al))
-(define (hm-assoc al k v)
-  (let loop ((ps al) (acc '()) (hit #f))
-    (cond ((null? ps) (reverse (if hit acc (cons (cons k v) acc))))
-          ((jolt=2 (caar ps) k) (loop (cdr ps) (cons (cons k v) acc) #t))
-          (else (loop (cdr ps) (cons (car ps) acc) hit)))))
-(define (hm-get al k) (let loop ((ps al)) (cond ((null? ps) jolt-nil) ((jolt=2 (caar ps) k) (cdar ps)) (else (loop (cdr ps))))))
-(define (coll->pairs m)
-  (if (jolt-nil? m) '()
-      (let loop ((s (jolt-seq m)) (acc '()))
-        (if (jolt-nil? s) (reverse acc)
-            (let ((e (seq-first s))) (loop (jolt-seq (seq-more s)) (cons (cons (jolt-nth e 0) (jolt-nth e 1)) acc)))))))
-(register-class-ctor! "HashMap"
-  (lambda args
-    (let ((init (and (pair? args) (car args))))
-      (make-jhost "hashmap" (vector (if (and init (not (number? init))) (coll->pairs init) '()))))))
-(register-host-methods! "hashmap"
-  (list (cons "get" (lambda (self k) (hm-get (hm-alist self) k)))
-        (cons "put" (lambda (self k v) (hm-set! self (hm-assoc (hm-alist self) k v)) v))
-        (cons "putAll" (lambda (self m) (for-each (lambda (p) (hm-set! self (hm-assoc (hm-alist self) (car p) (cdr p)))) (coll->pairs m)) jolt-nil))
-        (cons "containsKey" (lambda (self k) (not (jolt-nil? (hm-get (hm-alist self) k)))))
-        (cons "size" (lambda (self) (->num (length (hm-alist self)))))))
-
-;; ---- StringTokenizer --------------------------------------------------------
-;; state: a vector #(tokens-list pos)
-(define (tokenize s delims)
-  (let ((dset (string->list delims)))
-    (let loop ((chars (string->list s)) (cur '()) (toks '()))
-      (cond ((null? chars) (reverse (if (null? cur) toks (cons (list->string (reverse cur)) toks))))
-            ((memv (car chars) dset)
-             (loop (cdr chars) '() (if (null? cur) toks (cons (list->string (reverse cur)) toks))))
-            (else (loop (cdr chars) (cons (car chars) cur) toks))))))
-(register-class-ctor! "StringTokenizer"
-  (lambda (s . delims) (make-jhost "string-tokenizer"
-    (vector (tokenize (if (string? s) s (jolt-str-render-one s))
-                      (if (null? delims) " \t\n\r\f" (car delims))) 0))))
-(register-host-methods! "string-tokenizer"
-  (list (cons "hasMoreTokens" (lambda (self) (< (vector-ref (jhost-state self) 1) (length (vector-ref (jhost-state self) 0)))))
-        (cons "countTokens" (lambda (self) (->num (- (length (vector-ref (jhost-state self) 0)) (vector-ref (jhost-state self) 1)))))
-        (cons "nextToken" (lambda (self)
-                            (let ((toks (vector-ref (jhost-state self) 0)) (p (vector-ref (jhost-state self) 1)))
-                              (if (< p (length toks))
-                                  (begin (vector-set! (jhost-state self) 1 (+ p 1)) (list-ref toks p))
-                                  (error #f "NoSuchElementException")))))))
-
-;; ---- String / BigInteger / MapEntry constructors ----------------------------
-;; (String. bytes [charset]) decodes bytes (a bytevector OR a jolt byte-array)
-;; with the named charset (UTF-8 default; ISO-8859-1/latin1/ascii = one byte per
-;; char); else stringify. clj-http-lite's body coercion is (String. ^[B body cs).
-(define (string-charset-name rest)
-  (if (pair? rest)
-      (let ((c (car rest)))
-        (cond ((string? c) c)
-              ((and (jhost? c) (string=? (jhost-tag c) "charset"))
-               (let ((p (assq 'name (jhost-state c)))) (if p (jolt-str-render-one (cdr p)) "UTF-8")))
-              (else "UTF-8")))
-      "UTF-8"))
-(define (decode-bytevector bv rest)
-  (let ((cs (ascii-string-down (string-charset-name rest))))
-    (cond
-      ((or (string=? cs "utf-8") (string=? cs "utf8")) (utf8->string bv))
-      ((or (string=? cs "iso-8859-1") (string=? cs "latin1") (string=? cs "iso8859-1")
-           (string=? cs "us-ascii") (string=? cs "ascii"))
-       (list->string (map integer->char (bytevector->u8-list bv))))
-      ((or (string=? cs "utf-16") (string=? cs "utf16") (string=? cs "utf-16be") (string=? cs "unicode"))
-       (utf16->string bv (endianness big)))   ; respects a leading BOM
-      ((string=? cs "utf-16le") (utf16->string bv (endianness little)))
-      ((or (string=? cs "utf-32") (string=? cs "utf32") (string=? cs "utf-32be"))
-       (utf32->string bv (endianness big)))
-      ((string=? cs "utf-32le") (utf32->string bv (endianness little)))
-      (else (guard (e (#t (list->string (map integer->char (bytevector->u8-list bv))))) (utf8->string bv))))))
-(register-class-ctor! "String"
-  (lambda (x . rest)
-    (cond ((bytevector? x) (decode-bytevector x rest))
-          ((and (jolt-array? x) (eq? (jolt-array-kind x) 'byte)) (decode-bytevector (na-bytearray->bv x) rest))
-          ((string? x) x)
-          (else (jolt-str-render-one x)))))
-(register-class-ctor! "BigInteger"
-  (lambda (v) (parse-int-or-throw v 10 "BigInteger")))
-(register-class-ctor! "MapEntry" (lambda (k v) (make-map-entry k v)))
-;; JVM exception ctors -> a typed host throwable carrying the canonical :jolt/class
-;; (so class / instance? / getMessage / ex-message reflect the real type) and the
-;; message. Supports (E. msg), (E. msg cause), (E. cause), and (E.).
-(for-each
-  (lambda (nm)
-    (let ((canonical (or (resolve-class-hint nm) nm)))
-      (register-class-ctor! nm
-        (lambda args
-          (let* ((a0 (if (pair? args) (car args) jolt-nil))
-                 (rest (if (pair? args) (cdr args) '()))
-                 (cause (if (pair? rest) (car rest) jolt-nil)))
-            (cond
-              ((string? a0) (jolt-host-throwable canonical a0 cause))
-              ((jolt-nil? a0) (jolt-host-throwable canonical jolt-nil))
-              ;; (E. cause): a lone throwable arg is the cause, message nil.
-              ((and (null? rest) (ex-info-map? a0)) (jolt-host-throwable canonical jolt-nil a0))
-              (else (jolt-host-throwable canonical (jolt-str-render-one a0) cause))))))))
-  '("Throwable" "Exception" "RuntimeException" "IllegalArgumentException" "IllegalStateException"
-    "InterruptedException" "UnsupportedOperationException" "IOException" "NumberFormatException"
-    "ArithmeticException" "NullPointerException" "ClassCastException" "IndexOutOfBoundsException"
-    "FileNotFoundException" "UnsupportedEncodingException"))
-
-;; ---- URLEncoder / URLDecoder (www-form-urlencoded) --------------------------
-(define (url-unreserved? b)
-  (or (and (>= b 48) (<= b 57)) (and (>= b 65) (<= b 90)) (and (>= b 97) (<= b 122))
-      (= b 46) (= b 42) (= b 95) (= b 45)))
-(define hex-digits "0123456789ABCDEF")
-(define (url-encode s . _)
-  (let ((bs (string->utf8 (if (string? s) s (jolt-str-render-one s)))) (out '()))
-    (let loop ((i 0))
-      (if (= i (bytevector-length bs)) (list->string (reverse out))
-          (let ((b (bytevector-u8-ref bs i)))
-            (cond ((url-unreserved? b) (set! out (cons (integer->char b) out)))
-                  ((= b 32) (set! out (cons #\+ out)))
-                  (else (set! out (cons (string-ref hex-digits (bitwise-and b 15))
-                                   (cons (string-ref hex-digits (bitwise-arithmetic-shift-right b 4))
-                                     (cons #\% out))))))
-            (loop (+ i 1)))))))
-(define (hexv c)
-  (cond ((and (char<=? #\0 c) (char<=? c #\9)) (- (char->integer c) 48))
-        ((and (char<=? #\A c) (char<=? c #\F)) (- (char->integer c) 55))
-        ((and (char<=? #\a c) (char<=? c #\f)) (- (char->integer c) 87))
-        (else (error #f "URLDecoder: malformed escape"))))
-(define (url-decode s . _)
-  (let* ((str (if (string? s) s (jolt-str-render-one s))) (n (string-length str)) (out '()))
-    (let loop ((i 0))
-      (if (>= i n) (utf8->string (u8-list->bytevector (reverse out)))
-          (let ((c (string-ref str i)))
-            (cond ((char=? c #\+) (set! out (cons 32 out)) (loop (+ i 1)))
-                  ((char=? c #\%)
-                   (set! out (cons (+ (* 16 (hexv (string-ref str (+ i 1)))) (hexv (string-ref str (+ i 2)))) out))
-                   (loop (+ i 3)))
-                  (else (set! out (cons (char->integer c) out)) (loop (+ i 1)))))))))
-(define (u8-list->bytevector lst)
-  (let ((bv (make-bytevector (length lst))))
-    (let loop ((l lst) (i 0)) (if (null? l) bv (begin (bytevector-u8-set! bv i (car l)) (loop (cdr l) (+ i 1)))))))
-(register-class-statics! "URLEncoder" (list (cons "encode" url-encode)))
-(register-class-statics! "URLDecoder" (list (cons "decode" url-decode)))
-;; Charset/forName yields the canonical name STRING (not an opaque object) so it
-;; threads straight into (.getBytes s cs) / (String. bytes cs), which take a name.
-(register-class-statics! "Charset" (list (cons "forName" (lambda (nm) (jolt-str-render-one nm)))))
-
-;; ---- Base64 (RFC 4648) ------------------------------------------------------
-(define b64-alphabet "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/")
-(define (->bytevector x)
-  (cond ((bytevector? x) x)
-        ((and (jolt-array? x) (eq? (jolt-array-kind x) 'byte)) (na-bytearray->bv x))
-        ((string? x) (string->utf8 x))
-        (else (string->utf8 (jolt-str-render-one x)))))
-(define (b64-encode x)
-  (let* ((bs (->bytevector x)) (n (bytevector-length bs)) (out '()))
-    (let loop ((i 0))
-      (if (>= i n) (list->string (reverse out))
-          (let* ((b0 (bytevector-u8-ref bs i))
-                 (b1 (if (< (+ i 1) n) (bytevector-u8-ref bs (+ i 1)) #f))
-                 (b2 (if (< (+ i 2) n) (bytevector-u8-ref bs (+ i 2)) #f)))
-            (set! out (cons (string-ref b64-alphabet (bitwise-arithmetic-shift-right b0 2)) out))
-            (set! out (cons (string-ref b64-alphabet (bitwise-ior (bitwise-arithmetic-shift-left (bitwise-and b0 3) 4)
-                                                                  (bitwise-arithmetic-shift-right (or b1 0) 4))) out))
-            (set! out (cons (if b1 (string-ref b64-alphabet (bitwise-ior (bitwise-arithmetic-shift-left (bitwise-and b1 15) 2)
-                                                                         (bitwise-arithmetic-shift-right (or b2 0) 6))) #\=) out))
-            (set! out (cons (if b2 (string-ref b64-alphabet (bitwise-and b2 63)) #\=) out))
-            (loop (+ i 3)))))))
-(define (b64-char-val c)
-  (let loop ((i 0)) (cond ((= i 64) (error #f "Base64: illegal character")) ((char=? (string-ref b64-alphabet i) c) i) (else (loop (+ i 1))))))
-(define (b64-decode x)
-  (let* ((str (let ((s (if (string? x) x (utf8->string (->bytevector x)))))
-                (list->string (filter (lambda (c) (not (char=? c #\=))) (string->list s)))))
-         (out '()) (acc 0) (bits 0))
-    (for-each (lambda (c)
-                (set! acc (bitwise-ior (bitwise-arithmetic-shift-left acc 6) (b64-char-val c)))
-                (set! bits (+ bits 6))
-                (when (>= bits 8)
-                  (set! bits (- bits 8))
-                  (set! out (cons (bitwise-and (bitwise-arithmetic-shift-right acc bits) 255) out))))
-              (string->list str))
-    (u8-list->bytevector (reverse out))))
-(register-host-methods! "b64-encoder"
-  (list (cons "encode" (lambda (self bs) (string->utf8 (b64-encode bs))))
-        (cons "encodeToString" (lambda (self bs) (b64-encode bs)))))
-(register-host-methods! "b64-decoder"
-  (list (cons "decode" (lambda (self s) (b64-decode s)))))
-(register-class-statics! "Base64"
-  (list (cons "getEncoder" (lambda () (make-jhost "b64-encoder" '())))
-        (cons "getDecoder" (lambda () (make-jhost "b64-decoder" '())))))
-
-;; ---- java.util.regex.Pattern ------------------------------------------------
-;; Pattern/compile returns a jolt-regex value (regex-t), so str/replace, re-find,
-;; .split etc. accept it transparently.
-(define pattern-multiline 8.0)
-(define (pattern-quote s)
-  (let ((meta "\\.[]{}()*+-?^$|&") (s (if (string? s) s (jolt-str-render-one s))) (out '()))
-    (let loop ((i 0))
-      (if (= i (string-length s)) (list->string (reverse out))
-          (let ((c (string-ref s i)))
-            (when (memv c (string->list meta)) (set! out (cons #\\ out)))
-            (set! out (cons c out))
-            (loop (+ i 1)))))))
-(register-class-statics! "Pattern"
-  (list (cons "compile" (lambda (s . flags)
-                          (if (and (pair? flags) (= (bitwise-and (jnum->exact (car flags)) 8) 8))
-                              (jolt-regex (string-append "(?m)" s))
-                              (jolt-regex s))))
-        (cons "quote" (lambda (s) (pattern-quote s)))
-        (cons "MULTILINE" pattern-multiline)))
-;; record-method-dispatch already routes string? -> jolt-string-method. Add a
-;; regex-t arm (Pattern .split / .matcher-less surface used by corpus) by wrapping
-;; once more — a regex-t isn't a jhost.
-(define %hs-rmd2 record-method-dispatch)
-(set! record-method-dispatch
-  (lambda (obj method-name rest-args)
-    (if (regex-t? obj)
-        (let ((rest (if (jolt-nil? rest-args) '() (seq->list rest-args))))
-          (cond ((string=? method-name "split")
-                 ;; .split returns a String[] — a seq (prints
-                 ;; (a b c), not a vector). re-split with no limit; drop trailing
-                 ;; empties (JVM default).
-                 (let ((parts (re-split (regex-t-irx obj) (car rest) #f)))
-                   (list->cseq (str-split-drop-trailing parts))))
-                ((string=? method-name "pattern") (regex-t-source obj))
-                (else (error #f (string-append "No method " method-name " on Pattern")))))
-        (%hs-rmd2 obj method-name rest-args))))
-
-;; ---- def-var! the registry entry points so emit can also reach them ---------
-(def-var! "clojure.core" "host-static-ref" host-static-ref)
-(def-var! "clojure.core" "host-static-call" (lambda (c m . a) (apply host-static-call c m a)))
-(def-var! "clojure.core" "host-new" (lambda (c . a) (apply host-new c a)))
-
-;; Clojure-visible class-registration hooks. A host shim (e.g. reitit.trie-jolt,
-;; which mirrors the reitit.Trie Java class) registers a constructor proc or a
-;; map of static members against a class token so (Class. args) / (Class/member
-;; args) resolve to it. The statics argument is a jolt map {member-name -> val}.
-(define (jmap->static-alist m)
-  (let loop ((s (jolt-seq m)) (acc '()))
-    (if (jolt-nil? s) acc
-        (let ((e (jolt-first s)))
-          (loop (jolt-seq (jolt-rest s)) (cons (cons (jolt-nth e 0) (jolt-nth e 1)) acc))))))
-(def-var! "clojure.core" "__register-class-ctor!"
-  (lambda (name proc) (register-class-ctor! name proc) jolt-nil))
-(def-var! "clojure.core" "__register-class-statics!"
-  (lambda (name members) (register-class-statics! name (jmap->static-alist members)) jolt-nil))
-
-;; ---- tagged-table method dispatch + pluggable instance? --------------------
-;; A jolt library can build stateful host objects with (jolt.host/tagged-table
-;; tag) and dispatch (.method obj ...) to handlers registered here, keyed by the
-;; table's "jolt/type" tag — the htable analogue of the jhost method registry
-;; above. jolt-lang/http-client uses this to emulate java.net URL /
-;; HttpURLConnection / java.io byte streams so clj-http-lite runs unchanged.
-(define tagged-methods-tbl (make-hashtable string-hash string=?))   ; tag-key -> (method-ht)
-(define (tag->method-key tag)
-  (if (keyword-t? tag)
-      (let ((ns (keyword-t-ns tag)))
-        (if (and ns (not (jolt-nil? ns))) (string-append ns "/" (keyword-t-name tag)) (keyword-t-name tag)))
-      (jolt-str-render-one tag)))
-(define (register-tagged-methods! tag members)
-  (let* ((key (tag->method-key tag))
-         (h (or (hashtable-ref tagged-methods-tbl key #f)
-                (let ((nh (make-hashtable string-hash string=?)))
-                  (hashtable-set! tagged-methods-tbl key nh) nh))))
-    (for-each (lambda (p) (hashtable-set! h (car p) (cdr p))) members)))
-
-;; htable arm: dispatch (.method obj a*) through the table's tag method registry;
-;; an unregistered method falls through (sorted colls are htables too).
-(define %hs-rmd-htable record-method-dispatch)
-(set! record-method-dispatch
-  (lambda (obj method-name rest-args)
-    (let ((tag (and (htable? obj) (hashtable-ref (htable-h obj) "jolt/type" #f))))
-      (let* ((mh (and tag (hashtable-ref tagged-methods-tbl (tag->method-key tag) #f)))
-             (f  (and mh (hashtable-ref mh method-name #f))))
-        (if f
-            (apply f obj (if (jolt-nil? rest-args) '() (seq->list rest-args)))
-            (%hs-rmd-htable obj method-name rest-args))))))
-
-(def-var! "clojure.core" "__register-class-methods!"
-  (lambda (tag members) (register-tagged-methods! tag (jmap->static-alist members)) jolt-nil))
-
-;; 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)
-(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)
-            (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))
-
-;; (jolt.host/table? x) — is x a host tagged-table?
-(def-var! "jolt.host" "table?" (lambda (x) (if (htable? x) #t #f)))

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)
-(set! jolt-str-render-one (lambda (x) (if (htable-sorted? x) (sorted-render x jolt-str-render-one) (%h-str-render-one x))))
+(register-str-render! htable-sorted? (lambda (x) (sorted-render x jolt-str-render-one)))
 
 ;; --- 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

@@ -93,16 +93,16 @@
 (define (pad2 n) (if (< n 10) (string-append "0" (number->string n)) (number->string n)))
 (define (pad4 n) (let ((s (number->string n))) (string-append (make-string (max 0 (- 4 (string-length s))) #\0) s)))
 (define (pad3 n) (let ((s (number->string n))) (string-append (make-string (max 0 (- 3 (string-length s))) #\0) s)))
-(define (floor-div a b) (let ((q (quotient a b)) (r (remainder a b))) (if (and (not (= r 0)) (< (* a b) 0)) (- q 1) q)))
-(define (floor-mod a b) (- a (* (floor-div a b) b)))
+(define (inst-floor-div a b) (let ((q (quotient a b)) (r (remainder a b))) (if (and (not (= r 0)) (< (* a b) 0)) (- q 1) q)))
+(define (inst-floor-mod a b) (- a (* (inst-floor-div a b) b)))
 
 (define (inst-fields ms)                ; -> list (y mo d hh mm ss frac dow)
-  (let* ((total-s (floor-div (exact (truncate ms)) 1000))
+  (let* ((total-s (inst-floor-div (exact (truncate ms)) 1000))
          (frac (- (exact (truncate ms)) (* total-s 1000)))
-         (days (floor-div total-s 86400))
-         (sod (floor-mod total-s 86400))
+         (days (inst-floor-div total-s 86400))
+         (sod (inst-floor-mod total-s 86400))
          (hh (quotient sod 3600)) (mm (quotient (remainder sod 3600) 60)) (ss (remainder sod 60))
-         (dow (floor-mod (+ days 4) 7)))   ; 1970-01-01 = Thursday; 0=Sunday
+         (dow (inst-floor-mod (+ days 4) 7)))   ; 1970-01-01 = Thursday; 0=Sunday
     (call-with-values (lambda () (civil-from-days days))
       (lambda (y mo d) (list y mo d hh mm ss frac dow)))))
 
@@ -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)
-(set! jolt-str-render-one (lambda (x) (if (jinst? x) (inst-rfc3339 x) (%it-str-render x))))
+(register-str-render! jinst? inst-rfc3339)
 
 (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)
-(set! instance-check
+(register-instance-check-arm!
   (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))))
-        ((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) "local-dt")) (if (string=? tn "LocalDateTime") #t (%it-instance-check type-sym val)))
-        (else (%it-instance-check type-sym val))))))
-(def-var! "clojure.core" "instance-check" instance-check)
+                            (else 'pass)))
+        ((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 'pass))
+        (else 'pass)))))
 
 ;; 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)
-(set! jolt-str-render-one
-  (lambda (v) (if (jfile? v) (jfile-path v) (%io-str-render v))))
+(register-str-render! jfile? jfile-path)
 
 ;; 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)
-(set! instance-check
+(register-instance-check-arm!
   (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)))))
-(def-var! "clojure.core" "instance-check" instance-check)
+          'pass))))
 
 ;; --- def-var! the native names the overlay file-seq + str/slurp use ----
 (def-var! "clojure.core" "__make-file" jolt-make-file)
@@ -261,18 +257,6 @@
 (def-var! "clojure.core" "spit" jolt-spit)
 (def-var! "clojure.core" "flush" jolt-flush)
 
-;; --- char-array: a seq of chars over a string (the JVM char[]). io/reader's
-;; char[] branch + selmer's (char-array template) feed on this.
-;; char-array (string -> chars). A leaf array native; lives here as io/reader
-;; is its only Chez consumer so far.
-(define (jolt-char-array a . rest)
-  (cond
-    ((string? a) (list->cseq (string->list a)))
-    ((number? a) (list->cseq (make-list (exact (truncate a)) #\nul)))
-    (else (list->cseq (map (lambda (c) (if (char? c) c (integer->char (exact (truncate c)))))
-                           (seq->list a))))))
-(def-var! "clojure.core" "char-array" jolt-char-array)
-
 ;; --- with-open's close seam (__close): a map-like value closes via its :close
 ;; fn; a jhost reader/writer/file via its .close method (a no-op here); anything
 ;; else is an error.
@@ -323,7 +307,8 @@
 ;; --- clojure.java.io ns -----------------------------------------------------
 (def-var! "clojure.java.io" "file" jolt-make-file)
 (def-var! "clojure.java.io" "as-file" (lambda (x) (if (jfile? x) x (make-jfile (file-path-of x)))))
-(def-var! "clojure.java.io" "reader" jolt-io-reader)
+;; "reader" is bound by natives-array.ss (loaded later) so a char[] argument is
+;; handled; that binding delegates here via jolt-io-reader for everything else.
 (def-var! "clojure.java.io" "writer" jolt-io-writer)
 (def-var! "clojure.java.io" "input-stream" jolt-io-reader)
 (def-var! "clojure.java.io" "output-stream" jolt-io-writer)
@@ -486,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)
-(set! jolt-str-render-one
-  (lambda (x) (if (and (jhost? x) (string=? (jhost-tag x) "uri")) (uri-field x 'string) (%uri-str-render-one x))))
+(register-str-render! (lambda (x) (and (jhost? x) (string=? (jhost-tag x) "uri")))
+                      (lambda (x) (uri-field x 'string)))
 (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)
-(set! jolt-str-render-one (lambda (x) (if (jolt-lazyseq? x) (%ls-str-render-one (jolt-seq x)) (%ls-str-render-one x))))
+(register-str-render! jolt-lazyseq? (lambda (x) (jolt-str-render-one (jolt-seq 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/loader.ss

@@ -35,15 +35,17 @@
        (loop (cdr cs) '() (cons (list->string (reverse seg)) segs)))
       (else (loop (cdr cs) (cons (car cs) seg) segs)))))
 
-(define (find-ns-file name)
-  (let ((rel (ns-name->rel name)))
-    (let loop ((roots source-roots))
-      (if (null? roots) #f
-          (let ((clj  (string-append (car roots) "/" rel ".clj"))
-                (cljc (string-append (car roots) "/" rel ".cljc")))
-            (cond ((file-exists? clj) clj)
-                  ((file-exists? cljc) cljc)
-                  (else (loop (cdr roots)))))))))
+;; First existing <root>/rel.clj or <root>/rel.cljc on the search roots, else #f.
+(define (resolve-on-roots rel)
+  (let loop ((roots source-roots))
+    (if (null? roots) #f
+        (let ((clj  (string-append (car roots) "/" rel ".clj"))
+              (cljc (string-append (car roots) "/" rel ".cljc")))
+          (cond ((file-exists? clj) clj)
+                ((file-exists? cljc) cljc)
+                (else (loop (cdr roots))))))))
+
+(define (find-ns-file name) (resolve-on-roots (ns-name->rel name)))
 
 ;; --- the loaded set ---------------------------------------------------------
 ;; Seeded with every namespace that already has vars at load time — the baked
@@ -170,15 +172,10 @@
   (for-each
     (lambda (p)
       (let* ((rel (if (and (> (string-length p) 0) (char=? (string-ref p 0) #\/))
-                      (substring p 1 (string-length p)) p)))
-        (let loop ((roots source-roots))
-          (if (null? roots)
-              (error #f "Could not locate resource on source roots" p)
-              (let ((clj  (string-append (car roots) "/" rel ".clj"))
-                    (cljc (string-append (car roots) "/" rel ".cljc")))
-                (cond ((file-exists? clj) (load-jolt-file clj))
-                      ((file-exists? cljc) (load-jolt-file cljc))
-                      (else (loop (cdr roots)))))))))
+                      (substring p 1 (string-length p)) p))
+             (f (resolve-on-roots rel)))
+        (if f (load-jolt-file f)
+            (error #f "Could not locate resource on source roots" p))))
     paths)
   jolt-nil)
 (def-var! "clojure.core" "load" jolt-load)

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
-;; string (Class/forName "[C") or symbol; normalize, and pass a non-array string
-;; token on as a symbol so the inner wrappers' symbol-t-name doesn't choke.
-(define %na-instance-check instance-check)
-(set! instance-check
+;; instance? over an array class token ([I, [C, …). An array token reaches us as
+;; a string ("[C", from (Class/forName "[C")) — the dispatcher leaves it a string
+;; (non-array string tokens are already normalized to symbols there); decide it
+;; here, deferring everything else.
+(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
-        ((and tname (> (string-length tname) 0) (char=? (string-ref tname 0) #\[))
-         (and (jolt-array? val) (string=? (na-array-class-name val) tname)))
-        ((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)
+      (if (and tname (> (string-length tname) 0) (char=? (string-ref tname 0) #\[))
+          (and (jolt-array? val) (string=? (na-array-class-name val) tname))
+          'pass))))
 
 ;; 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)
-(set! jolt-str-render-one (lambda (x) (if (juuid? x) (juuid-s x) (%m-str-render-one x))))
+(register-str-render! juuid? juuid-s)
 (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)
-(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))))
+(register-str-render! jolt-queue? (lambda (x) (jolt-str-render-one (jolt-seq-or-empty 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)
-(set! instance-check
+(register-instance-check-arm!
   (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))))
-(def-var! "clojure.core" "instance-check" instance-check)
+        'pass)))
 
 ;; clojure.lang.PersistentQueue/EMPTY + a queue? predicate.
 (register-class-statics! "PersistentQueue" (list (cons "EMPTY" jolt-queue-empty)))

host/chez/natives-str.ss

@@ -196,13 +196,10 @@
     (if (fx<? i 0) jolt-nil i)))
 
 ;; (str-join coll [sep]) -> stringify each element (Clojure str), join by sep.
+;; str-join-strs (defined below) does the join; here we just render each element.
 (define (str-join coll . opt)
-  (let ((sep (if (pair? opt) (jolt-str-render-one (car opt)) ""))
-        (items (map jolt-str-render-one (seq->list coll))))
-    (let loop ((xs items) (first #t) (acc '()))
-      (cond ((null? xs) (apply string-append (reverse acc)))
-            (first (loop (cdr xs) #f (cons (car xs) acc)))
-            (else (loop (cdr xs) #f (cons (car xs) (cons sep acc))))))))
+  (let ((sep (if (pair? opt) (jolt-str-render-one (car opt)) "")))
+    (str-join-strs (map jolt-str-render-one (seq->list coll)) sep)))
 
 ;; (re-split irx s limit) -> parts, splitting at each match. Keeps interior AND
 ;; trailing empty strings (the clojure.string wrapper drops trailing for limit 0);

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)
-(set! jolt-str-render-one (lambda (x) (if (jns? x) (jns-name x) (%ns-str-render-one x))))
+(register-str-render! jns? jns-name)

host/chez/records-interop.ss

@@ -0,0 +1,115 @@
+;; records-interop.ss — JVM-emulation taxonomy split out of records.ss: the
+;; ex-info class accessors, the exception supertype hierarchy, and instance-check
+;; / case-string (the (instance? Class x) decision table). Loaded right after
+;; records.ss; instance-check forward-refs nothing in records.ss at load time.
+
+;; pmap? guard: ex-info maps are plain hash-maps, never sorted-map htables — and a
+;; bare jolt-get on a sorted-map would invoke its comparator on :jolt/type and throw.
+(define (ex-info-map? v)
+  (and (pmap? v) (jolt=2 (jolt-get v jolt-kw-ex-type jolt-nil) jolt-kw-ex-info)))
+(define (ex-info-class v)
+  (let ((c (jolt-get v jolt-kw-class jolt-nil)))
+    (if (string? c) c "clojure.lang.ExceptionInfo")))
+;; immediate-parent chain of the JVM exception hierarchy (simple names). Drives
+;; instance? across exception supertypes — (instance? Throwable (ex-info …)) etc.
+(define exception-parent
+  '(("ExceptionInfo" . "RuntimeException")
+    ("RuntimeException" . "Exception")
+    ("IllegalArgumentException" . "RuntimeException")
+    ("NumberFormatException" . "IllegalArgumentException")
+    ("IllegalStateException" . "RuntimeException")
+    ("UnsupportedOperationException" . "RuntimeException")
+    ("ArithmeticException" . "RuntimeException")
+    ("NullPointerException" . "RuntimeException")
+    ("ClassCastException" . "RuntimeException")
+    ("IndexOutOfBoundsException" . "RuntimeException")
+    ("ConcurrentModificationException" . "RuntimeException")
+    ("NoSuchElementException" . "RuntimeException")
+    ("UncheckedIOException" . "RuntimeException")
+    ("InterruptedException" . "Exception")
+    ("IOException" . "Exception")
+    ("FileNotFoundException" . "IOException")
+    ("UnsupportedEncodingException" . "IOException")
+    ("UnknownHostException" . "IOException")
+    ("SocketException" . "IOException")
+    ("ConnectException" . "IOException")
+    ("SocketTimeoutException" . "IOException")
+    ("MalformedURLException" . "IOException")
+    ("SSLException" . "IOException")
+    ("Exception" . "Throwable")
+    ("Error" . "Throwable")
+    ("AssertionError" . "Error")
+    ("Throwable" . "Object")))
+;; Is `wanted` (simple name) `cls` or a supertype of it? ExceptionInfo also
+;; implements the IExceptionInfo interface.
+(define (exception-isa? cls wanted)
+  (let loop ((c cls))
+    (cond ((not c) #f)
+          ((string=? c wanted) #t)
+          ((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. 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)
+       (let ((tag (jrec-tag val)))
+         (or (string=? tag tname)
+             (and (> (string-length tag) (string-length tname))
+                  (string=? (substring tag (- (string-length tag) (string-length tname)) (string-length tag)) tname)))))
+      ((jreify? val) (let ((short (last-dot tname)))
+                       (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))
+    ((member tname '("Long" "java.lang.Long" "Integer" "java.lang.Integer"))
+     (and (number? val) (exact? val) (integer? val)))
+    ((member tname '("Double" "java.lang.Double" "Float" "java.lang.Float")) (and (number? val) (flonum? val)))
+    ((member tname '("Ratio" "clojure.lang.Ratio")) (and (number? val) (exact? val) (rational? val) (not (integer? val))))
+    ((member tname '("String" "java.lang.String" "CharSequence" "java.lang.CharSequence")) (string? val))
+    ((member tname '("Boolean" "java.lang.Boolean")) (boolean? val))
+    ((member tname '("Character" "java.lang.Character")) (char? val))
+    ((member tname '("Keyword" "clojure.lang.Keyword")) (keyword? val))
+    ((member tname '("Symbol" "clojure.lang.Symbol")) (jolt-symbol? val))
+    ((member tname '("Atom" "clojure.lang.Atom")) (jolt-atom? val))
+    ((member tname '("IFn" "clojure.lang.IFn" "Fn" "clojure.lang.Fn")) (procedure? val))
+    ((member tname '("Pattern" "java.util.regex.Pattern")) (regex-t? val))
+    ((member tname '("URI" "java.net.URI"))
+     (and (jhost? val) (string=? (jhost-tag val) "uri")))
+    ((member tname '("File" "java.io.File")) (jfile? val))
+    ((member tname '("UUID" "java.util.UUID")) (juuid? val))
+    (else #f)))
+
+;; str of a record uses a custom (Object toString) impl if the type defines one
+;; (deftype with no default toString relies on this); otherwise the map form
+;; without the leading # (Clojure's record .toString). converters.ss loads before
+;; records.ss, so this set! sees the registry — forward refs resolve at call time.
+
+(def-var! "clojure.core" "instance-check" instance-check)

host/chez/records.ss

@@ -174,7 +174,9 @@
                  (keyword #f "name") (jolt-symbol jolt-nil name-str)
                  (keyword #f "methods") methods))
 
-;; register-protocol-methods!: a no-op for Chez dispatch.
+;; register-protocol-methods!: intentional no-op. Chez dispatches a protocol method
+;; by the receiver's type tag at call time, so there is no method table to register;
+;; this binding exists only because defprotocol-emitted code calls it.
 (define (register-protocol-methods! proto-name method-names) jolt-nil)
 
 ;; register-method: extend-type/extend register an impl. Host type names keep a
@@ -329,7 +331,7 @@
              ((string=? method-name "toString") (condition->message-string obj))
              ((string=? method-name "getCause") jolt-nil)
              ;; java.sql.SQLException chaining — jolt errors don't chain (nil).
-             ((or (string=? method-name "getNextException") (string=? method-name "getCause")) jolt-nil)
+             ((string=? method-name "getNextException") jolt-nil)
              ((string=? method-name "getStackTrace") (jolt-vector))
              ((string=? method-name "printStackTrace") jolt-nil)
              (else (error #f (string-append "No method " method-name " on Throwable")))))
@@ -408,98 +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.
-;; pmap? guard: ex-info maps are plain hash-maps, never sorted-map htables — and a
-;; bare jolt-get on a sorted-map would invoke its comparator on :jolt/type and throw.
-(define (ex-info-map? v)
-  (and (pmap? v) (jolt=2 (jolt-get v jolt-kw-ex-type jolt-nil) jolt-kw-ex-info)))
-(define (ex-info-class v)
-  (let ((c (jolt-get v jolt-kw-class jolt-nil)))
-    (if (string? c) c "clojure.lang.ExceptionInfo")))
-;; immediate-parent chain of the JVM exception hierarchy (simple names). Drives
-;; instance? across exception supertypes — (instance? Throwable (ex-info …)) etc.
-(define exception-parent
-  '(("ExceptionInfo" . "RuntimeException")
-    ("RuntimeException" . "Exception")
-    ("IllegalArgumentException" . "RuntimeException")
-    ("NumberFormatException" . "IllegalArgumentException")
-    ("IllegalStateException" . "RuntimeException")
-    ("UnsupportedOperationException" . "RuntimeException")
-    ("ArithmeticException" . "RuntimeException")
-    ("NullPointerException" . "RuntimeException")
-    ("ClassCastException" . "RuntimeException")
-    ("IndexOutOfBoundsException" . "RuntimeException")
-    ("ConcurrentModificationException" . "RuntimeException")
-    ("NoSuchElementException" . "RuntimeException")
-    ("UncheckedIOException" . "RuntimeException")
-    ("InterruptedException" . "Exception")
-    ("IOException" . "Exception")
-    ("FileNotFoundException" . "IOException")
-    ("UnsupportedEncodingException" . "IOException")
-    ("UnknownHostException" . "IOException")
-    ("SocketException" . "IOException")
-    ("ConnectException" . "IOException")
-    ("SocketTimeoutException" . "IOException")
-    ("MalformedURLException" . "IOException")
-    ("SSLException" . "IOException")
-    ("Exception" . "Throwable")
-    ("Error" . "Throwable")
-    ("AssertionError" . "Error")
-    ("Throwable" . "Object")))
-;; Is `wanted` (simple name) `cls` or a supertype of it? ExceptionInfo also
-;; implements the IExceptionInfo interface.
-(define (exception-isa? cls wanted)
-  (let loop ((c cls))
-    (cond ((not c) #f)
-          ((string=? c wanted) #t)
-          ((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)
-  (let ((tname (symbol-t-name type-sym)))
-    (cond
-      ((jrec? val)
-       (let ((tag (jrec-tag val)))
-         (or (string=? tag tname)
-             (and (> (string-length tag) (string-length tname))
-                  (string=? (substring tag (- (string-length tag) (string-length tname)) (string-length tag)) tname)))))
-      ((jreify? val) (let ((short (last-dot tname)))
-                       (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 (case-string tname val)
-  (cond
-    ((member tname '("Number" "java.lang.Number")) (number? val))
-    ((member tname '("Long" "java.lang.Long" "Integer" "java.lang.Integer"))
-     (and (number? val) (exact? val) (integer? val)))
-    ((member tname '("Double" "java.lang.Double" "Float" "java.lang.Float")) (and (number? val) (flonum? val)))
-    ((member tname '("Ratio" "clojure.lang.Ratio")) (and (number? val) (exact? val) (rational? val) (not (integer? val))))
-    ((member tname '("String" "java.lang.String" "CharSequence" "java.lang.CharSequence")) (string? val))
-    ((member tname '("Boolean" "java.lang.Boolean")) (boolean? val))
-    ((member tname '("Character" "java.lang.Character")) (char? val))
-    ((member tname '("Keyword" "clojure.lang.Keyword")) (keyword? val))
-    ((member tname '("Symbol" "clojure.lang.Symbol")) (jolt-symbol? val))
-    ((member tname '("Atom" "clojure.lang.Atom")) (jolt-atom? val))
-    ((member tname '("IFn" "clojure.lang.IFn" "Fn" "clojure.lang.Fn")) (procedure? val))
-    ((member tname '("Pattern" "java.util.regex.Pattern")) (regex-t? val))
-    ((member tname '("URI" "java.net.URI"))
-     (and (jhost? val) (string=? (jhost-tag val) "uri")))
-    ((member tname '("File" "java.io.File")) (jfile? val))
-    ((member tname '("UUID" "java.util.UUID")) (juuid? val))
-    (else #f)))
-
-;; str of a record uses a custom (Object toString) impl if the type defines one
-;; (deftype with no default toString relies on this); otherwise the map form
-;; without the leading # (Clojure's record .toString). converters.ss loads before
-;; records.ss, so this set! sees the registry — forward refs resolve at call time.
-(define %r-str-render-one jolt-str-render-one)
-(set! jolt-str-render-one
+(register-str-render! jrec?
   (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)))))
-        (%r-str-render-one 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)))))))
 
 ;; `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
@@ -514,6 +429,5 @@
 (def-var! "clojure.core" "protocol-dispatch" (lambda (pn mn obj rest) (protocol-dispatch pn mn obj rest)))
 (def-var! "clojure.core" "satisfies?" jolt-satisfies?)
 (def-var! "clojure.core" "extenders" extenders)
-(def-var! "clojure.core" "instance-check" instance-check)
 (def-var! "clojure.core" "make-reified" (lambda (mm . rest) (apply make-reified mm rest)))
 (def-var! "clojure.core" "record-method-dispatch" (lambda (obj m rest) (record-method-dispatch obj m rest)))

host/chez/rt.ss

@@ -237,6 +237,7 @@
 ;; the dispatchers/printers it wraps (collections/seq/values/converters/printing/
 ;; transients).
 (load "host/chez/records.ss")
+(load "host/chez/records-interop.ss")   ; exception hierarchy + instance-check taxonomy
 
 ;; metadata: meta / with-meta over an identity-keyed
 ;; side-table. After records.ss (jrec) + the collection ctors it copies.
@@ -303,7 +304,9 @@
 ;; host-static-call/host-new + the jhost method registry. Loads LAST — it extends
 ;; record-method-dispatch (records.ss) and reuses natives-str helpers (str-trim,
 ;; ascii-string-down, re-split, str-split-drop-trailing) + the regex-t accessors.
-(load "host/chez/host-static.ss")
+(load "host/chez/host-static.ss")          ; registries + jhost + coercion helpers
+(load "host/chez/host-static-statics.ss")  ; java.lang/util static methods
+(load "host/chez/host-static-objects.ss")  ; host object classes + instance? hook
 
 ;; generic dot-form dispatch: field access + map/vector member access
 ;; for the `.` / `.-field` desugar. Loads after host-static.ss so it wraps every

host/chez/run-infer.ss

@@ -0,0 +1,106 @@
+;; run-infer.ss — inference / success-type-checking gate (jolt.passes.types).
+;;
+;; The corpus and unit gates compile through run-passes' const-fold-only branch,
+;; so the inference walk (jolt.passes.types) runs only under `jolt build --opt` —
+;; buildsmoke exercises it on one trivial app and asserts stdout only. This gate
+;; drives the pass DIRECTLY: analyze a source string to IR, then call the public
+;; checker/driver entry points (check-form, infer-body, the set-*! registries) and
+;; assert their observable output (diagnostic counts, collected calls/escapes). It
+;; pins the behavior the inference walk's internal state produces, so a refactor of
+;; that state is gate-validatable.
+;;
+;;   chez --script host/chez/run-infer.ss
+(import (chezscheme))
+
+(load "host/chez/rt.ss")
+(set-chez-ns! "clojure.core")
+(load "host/chez/seed/prelude.ss")
+(load "host/chez/post-prelude.ss")
+(set-chez-ns! "user")
+(load "host/chez/host-contract.ss")
+(load "host/chez/seed/image.ss")
+(load "host/chez/compile-eval.ss")
+
+(define analyze            (var-deref "jolt.analyzer" "analyze"))
+(define check-form         (var-deref "jolt.passes.types" "check-form"))
+(define infer-body         (var-deref "jolt.passes.types" "infer-body"))
+(define reset-escapes!     (var-deref "jolt.passes.types" "reset-escapes!"))
+(define collected-escapes  (var-deref "jolt.passes.types" "collected-escapes"))
+(define set-record-shapes! (var-deref "jolt.passes.types" "set-record-shapes!"))
+(define set-vtypes!        (var-deref "jolt.passes.types" "set-vtypes!"))
+(define set-check-mode!    (var-deref "jolt.passes.types" "set-check-mode!"))
+(define run-inference      (var-deref "jolt.passes.types" "run-inference"))
+(define take-diags!        (var-deref "jolt.passes.types" "take-diags!"))
+
+;; analyze a source string to its IR node (fresh ctx, ns "user", no passes).
+(define (anode src) (analyze (make-analyze-ctx "user") (jolt-ce-read src)))
+;; number of success-type diagnostics check-form produces for src.
+(define (diags src strict?) (jolt-count (check-form (anode src) strict?)))
+
+(define fails 0)
+(define total 0)
+(define (check label actual expected)
+  (set! total (+ total 1))
+  (unless (equal? actual expected)
+    (set! fails (+ fails 1))
+    (printf "  FAIL ~a: got ~s expected ~s\n" label actual expected)))
+
+;; --- core error-domain checking (strict not required) -----------------------
+(check "num-op on keyword"        (diags "(+ 1 :k)" #f) 1)
+(check "num-op all numbers"       (diags "(+ 1 2)" #f) 0)
+(check "count on number"          (diags "(count 5)" #f) 1)
+(check "count on vector"          (diags "(count [1 2])" #f) 0)
+(check "lenient (:k 5)"           (diags "(:k 5)" #f) 0)
+(check "call a number"            (diags "(5 1)" #f) 1)
+(check "nested count return type" (diags "(+ 1 (count :k))" #f) 1)
+
+;; --- walk arms thread the type env ------------------------------------------
+(check "let binds kw"             (diags "(let [x :k] (+ x 1))" #f) 1)
+(check "let binds ok"             (diags "(let [x 1] (+ x 1))" #f) 0)
+(check "if then branch error"     (diags "(if true (+ 1 :k) 2)" #f) 1)
+(check "do statement error"       (diags "(do (+ 1 :k) 2)" #f) 1)
+(check "mapv seeds element type"  (diags "(mapv (fn [x] (+ x 1)) [:a :b])" #f) 1)
+(check "mapv ok element type"     (diags "(mapv (fn [x] (+ x 1)) [1 2])" #f) 0)
+(check "reduce seeds element"     (diags "(reduce (fn [acc x] (+ acc x)) 0 [:a])" #f) 1)
+
+;; --- strict user-function domains (checking-box / diag-memo / user-sig) ------
+(check "user wrong arg type"      (diags "(do (defn f [x] (+ x 1)) (f :k))" #t) 1)
+(check "user wrong arity"         (diags "(do (defn g [x] x) (g 1 2))" #t) 1)
+(check "user call ok"             (diags "(do (defn h [x] (+ x 1)) (h 3))" #t) 0)
+(check "user domains off w/o strict" (diags "(do (defn f [x] (+ x 1)) (f :k))" #f) 0)
+;; recursive user fn terminates (cycle guard) and still flags the bad arg
+(check "user recursive terminates"
+       (diags "(do (defn rf [x] (+ x (rf x))) (rf :k))" #t) 1)
+
+;; --- infer-body collects calls + escapes ------------------------------------
+(reset-escapes!)
+(let ((r (infer-body (anode "(do (foo 1) (bar 2) (map inc [1]))") (jolt-hash-map))))
+  (check "infer-body calls" (jolt-count (jolt-nth r 2)) 3)        ; foo, bar, map
+  (check "infer-body escapes" (jolt-count (collected-escapes)) 1)) ; inc (value position)
+
+;; --- the record-shapes registry feeds call-result types --------------------
+;; without shapes a (->P …) call result is :any (accepted); with the registry it
+;; types as a struct, so an arithmetic op over it is provably not-a-number.
+(check "ctor result :any w/o shapes" (diags "(+ (->P 1) 1)" #f) 0)
+(set-record-shapes!
+  (jolt-hash-map "user/->P"
+                 (jolt-hash-map (keyword #f "fields") (jolt-vector (keyword #f "x"))
+                                (keyword #f "tags")   (jolt-vector jolt-nil)
+                                (keyword #f "type")   "user.P")))
+(check "ctor result struct w/ shapes" (diags "(+ (->P 1) 1)" #f) 1)
+(set-record-shapes! (jolt-hash-map))
+
+;; --- the opt-path checker: run-inference emits, take-diags! drains -----------
+;; (set-check-mode! on strict?) arms checking during the next run-inference; the
+;; diagnostics are stashed for take-diags! to drain once.
+(set-check-mode! #t #f)
+(run-inference (anode "(+ 1 :k)"))
+(check "take-diags drains run-inference" (jolt-count (take-diags!)) 1)
+(check "take-diags re-drained empty"     (jolt-count (take-diags!)) 0)
+(set-check-mode! #f #f)
+(run-inference (anode "(+ 1 :k)"))
+(check "no diags when check-mode off"    (jolt-count (take-diags!)) 0)
+
+(if (= fails 0)
+    (begin (printf "infer gate: ~a/~a passed\n" total total) (exit 0))
+    (begin (printf "infer gate: ~a/~a passed (~a failed)\n" (- total fails) total fails) (exit 1)))

host/chez/seq.ss

@@ -206,7 +206,13 @@
                          (if (jolt-reduced? r) (jolt-reduced-val r) r))))
        (else (reduce-seq f init (jolt-seq coll)))))))
 
-(define (jolt-into to from) (reduce-seq (lambda (acc x) (jolt-conj1 acc x)) to (jolt-seq from)))
+;; Fold through a transient so a pvec/pmap/pset target is built in O(n): a
+;; persistent pvec-conj copies its whole backing vector each step, making a naive
+;; fold O(n^2) (and into/vec/mapv/filterv all route here). jolt-transient-new
+;; falls back to a copy-on-write wrapper for other targets (lists, sorted colls,
+;; nil), so those keep the old per-step jolt-conj behaviour.
+(define (jolt-into to from)
+  (jolt-persistent! (reduce-seq (lambda (t x) (jolt-conj! t x)) (jolt-transient-new to) (jolt-seq from))))
 
 (define (range-from n) (cseq-lazy n (lambda () (range-from (+ n 1)))))
 (define (range-bounded n end step)

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)
-(set! jolt-str-render-one (lambda (x) (if (var-cell? x) (var->str x) (%v-str-render-one x))))
+(register-str-render! var-cell? var->str)
 
 ;; 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))))

jolt-core/clojure/core/20-coll.clj

@@ -188,13 +188,15 @@
 
 (defn replicate [n x] (map (fn [_] x) (range n)))
 
+;; Returns a seq (JVM does), nil when n<=0 or coll is empty.
 (defn take-last [n coll]
   (let [c (vec coll) len (count c)]
-    (when (pos? len) (subvec c (max 0 (- len n))))))
+    (when (pos? len) (seq (subvec c (max 0 (- len n)))))))
 
+;; The JVM definition: a lazy seq (() when empty), not a vector.
 (defn drop-last
   ([coll] (drop-last 1 coll))
-  ([n coll] (let [c (vec coll)] (subvec c 0 (max 0 (- (count c) n))))))
+  ([n coll] (map (fn [x _] x) coll (drop n coll))))
 
 (defn distinct?
   ([x] true)
@@ -453,671 +455,3 @@
 (defn println-str [& xs] (__with-out-str (fn* [] (apply println xs))))
 (defn prn-str [& xs] (__with-out-str (fn* [] (apply prn xs))))
 
-;; --- leaves over the rand / sort host seams ----------------------------------
-
-;; Canonical truncation toward zero via int (the kernel fn floored, which is
-;; wrong for a negative n).
-(defn rand-int [n] (int (rand n)))
-
-;; Pure-functional Fisher-Yates over vector assoc; returns a vector, as in
-;; Clojure. Collections only — a string is seqable but not shuffleable, as on
-;; the JVM (Collections/shuffle wants a Collection).
-(defn shuffle [coll]
-  (when-not (coll? coll)
-    (throw (ex-info (str "shuffle requires a collection, got: " coll) {})))
-  (loop [v (vec coll) i (dec (count v))]
-    (if (pos? i)
-      (let [j (rand-int (inc i))
-            t (nth v i)]
-        (recur (assoc (assoc v i (nth v j)) j t) (dec i)))
-      v)))
-
-;; Canonical sort-by: the default comparator is compare (so nil sorts first,
-;; like Clojure — the kernel fn used host ordering, which put nil last); the
-;; comparator compares KEYS and may be 3-way or a boolean predicate (the host
-;; sort seam normalizes).
-(defn sort-by
-  ([keyfn coll] (sort-by keyfn compare coll))
-  ([keyfn comp coll]
-   (sort (fn [x y] (comp (keyfn x) (keyfn y))) coll)))
-
-;; parse-uuid: nil unless s is a canonical 8-4-4-4-12 hex UUID string; throws
-;; on a non-string (Clojure 1.11). __make-uuid is the host constructor for the
-;; tagged value (overlay source can't write :jolt/type map literals — the
-;; reader treats them as tagged forms).
-(defn parse-uuid [s]
-  (if (string? s)
-    (when (re-matches
-           #"[0-9a-fA-F]{8}-[0-9a-fA-F]{4}-[0-9a-fA-F]{4}-[0-9a-fA-F]{4}-[0-9a-fA-F]{12}" s)
-      (__make-uuid s))
-    (throw (str "parse-uuid requires a string, got: " s))))
-
-;; Version-4 UUID (RFC 4122): zero-padded hex groups 8-4-4-4-12, version
-;; nibble 4, variant 8-b — built over rand-int and validated by parse-uuid.
-(defn random-uuid []
-  (let [hx4 (fn [] (format "%04x" (rand-int 0x10000)))
-        hx3 (fn [] (format "%03x" (rand-int 0x1000)))]
-    (parse-uuid (str (hx4) (hx4) "-" (hx4) "-4" (hx3)
-                     "-" (format "%x" (+ 8 (rand-int 4))) (hx3)
-                     "-" (hx4) (hx4) (hx4)))))
-
-;; The char escape/name tables, as char-keyed maps (Clojure's shape).
-(def ^:private char-escape-strings
-  {\newline "\\n" \tab "\\t" \return "\\r" \formfeed "\\f"
-   \backspace "\\b" \" "\\\"" \\ "\\\\"})
-(defn char-escape-string [c] (get char-escape-strings c))
-
-(def ^:private char-name-strings
-  {\newline "newline" \tab "tab" \return "return" \formfeed "formfeed"
-   \backspace "backspace" \space "space"})
-(defn char-name-string [c] (get char-name-strings c))
-
-;; Random selection over the host rand primitives.
-(defn rand-nth [coll]
-  (let [v (vec coll)] (nth v (rand-int (count v)))))
-
-(defn random-sample
-  ([prob] (filter (fn [_] (< (rand) prob))))
-  ([prob coll] (filter (fn [_] (< (rand) prob)) coll)))
-
-(defn comparator [pred]
-  (fn [a b] (cond (pred a b) -1 (pred b a) 1 :else 0)))
-
-;; Lazy: the running accumulators, one at a time (matches Clojure).
-(defn reductions
-  ([f coll]
-   (lazy-seq
-     (let [s (seq coll)]
-       (if s
-         (reductions f (first s) (rest s))
-         (list (f))))))
-  ([f init coll]
-   (cons init
-         (lazy-seq
-           (when-let [s (seq coll)]
-             (reductions f (f init (first s)) (rest s)))))))
-
-;; Lazy pre-order DFS (matches Clojure): node, then its children's walks spliced
-;; via the (now lazy) mapcat.
-(defn tree-seq [branch? children root]
-  (let [walk (fn walk [node]
-               (lazy-seq
-                 (cons node
-                       (when (branch? node)
-                         (mapcat walk (children node))))))]
-    (walk root)))
-
-;; file-seq: the tree of paths under root (root included), directories walked
-;; via the host dir primitives. Paths (strings), not File objects. (Lives below
-;; tree-seq: forward references are analysis errors.)
-(defn file-seq [root]
-  (if (__file? root)
-    ;; java.io.File tree: walk via the File method surface so leaves are File
-    ;; values callers can invoke .isFile/.getName/slurp on.
-    (tree-seq (fn [f] (.isDirectory f)) (fn [f] (seq (.listFiles f))) root)
-    (tree-seq __dir? __list-dir root)))
-
-;; Canonical flatten via tree-seq: the leaves (non-sequential nodes) in order.
-;; Flattens lists too (sequential?), matching Clojure/CLJS.
-(defn flatten [coll]
-  (filter (complement sequential?) (rest (tree-seq sequential? seq coll))))
-
-;; xml-seq: tree-seq over XML element trees. Elements are maps with :content.
-(defn xml-seq [root]
-  (tree-seq (complement string?) (comp seq :content) root))
-
-;; Lazy interleave: round-robin one element from each coll until any exhausts.
-(defn interleave
-  ([] ())
-  ([c1] (lazy-seq c1))
-  ([c1 c2]
-   (lazy-seq
-     (let [s1 (seq c1) s2 (seq c2)]
-       (when (and s1 s2)
-         (cons (first s1)
-               (cons (first s2)
-                     (interleave (rest s1) (rest s2))))))))
-  ([c1 c2 & cs]
-   (lazy-seq
-     (let [ss (map seq (list* c1 c2 cs))]
-       (when (every? identity ss)
-         (concat (map first ss)
-                 (apply interleave (map rest ss))))))))
-
-;; No ratio type on Jolt, so rationalize is identity.
-(defn rationalize [x] x)
-
-;; 0-arg: a stateful transducer (tracks [seen? prev] in a volatile, so no sentinel
-;; value is needed). 1-arg: eager dedupe of consecutive equal elements.
-(defn dedupe
-  ([]
-   (fn [rf]
-     (let [pv (volatile! [false nil])]
-       (fn
-         ([] (rf))
-         ([result] (rf result))
-         ([result input]
-          (let [[seen prior] @pv]
-            (vreset! pv [true input])
-            (if (and seen (= prior input)) result (rf result input))))))))
-  ([coll]
-   (let [step (fn step [s prev]
-                (make-lazy-seq
-                  (fn* []
-                    (let [s (seq s)]
-                      (if s
-                        (let [x (first s)]
-                          (if (= x prev)
-                            (coll->cells (step (rest s) prev))
-                            (coll->cells (cons x (step (rest s) x)))))
-                        nil)))))]
-     (let [s (seq coll)]
-       (if s
-         (make-lazy-seq
-           (fn* [] (coll->cells (cons (first s) (step (rest s) (first s))))))
-         ())))))
-
-;; Internal helper for {:keys [...]} destructuring over a seq of k/v pairs —
-;; canonical Clojure 1.11 shape (core.clj seq-to-map-for-destructuring):
-;; even pairs build a map (later keys win, as createAsIfByAssoc), a SINGLE
-;; element is returned as-is (the trailing-map calling convention), and an
-;; unpaired key past pairs throws.
-(defn seq-to-map-for-destructuring [s]
-  (if (next s)
-    (loop [m {} xs (seq s)]
-      (if xs
-        (if (next xs)
-          (recur (assoc m (first xs) (second xs)) (nnext xs))
-          (throw (str "No value supplied for key: " (first xs))))
-        m))
-    (if (seq s) (first s) {})))
-
-;; Host-coupled fns that are pure logic over existing core primitives, so they
-;; need no new jolt.host surface.
-
-;; vary-meta: f applied to obj's metadata (+ extra args), reattached. meta and
-;; with-meta are the irreducible host primitives; vary-meta is just their compose.
-(defn vary-meta [obj f & args]
-  (with-meta obj (apply f (meta obj) args)))
-
-;; namespace-munge: Clojure namespace name -> legal Java package name (- -> _).
-(defn namespace-munge [s]
-  (apply str (map (fn [c] (if (= c \-) \_ c)) (seq (str s)))))
-
-;; reduce-kv over a map (k v) or vector (index v). Both branches go through reduce,
-;; so reduced short-circuits — and the vector path indexes correctly. nil folds
-;; to init, matching Clojure.
-(defn reduce-kv [f init coll]
-  (cond
-    (vector? coll) (reduce (fn [acc i] (f acc i (nth coll i))) init (range (count coll)))
-    (map? coll)    (reduce (fn [acc k] (f acc k (get coll k))) init (keys coll))
-    (nil? coll)    init
-    :else (throw (str "reduce-kv not supported on: " coll))))
-
-;; ex-info accessors. The constructor (ex-info) stays native — it builds the tagged
-;; value and wires into throw — but the value exposes :jolt/type/:message/:data/
-;; :cause via get, so the accessors are pure over get. A thrown non-ex-info arrives
-;; wrapped as {:jolt/type :jolt/exception :value v}; unwrap that first.
-(defn- ex-info-val? [x] (= (get x :jolt/type) :jolt/ex-info))
-(defn- ex-unwrap [e]
-  (if (= (get e :jolt/type) :jolt/exception) (get e :value) e))
-(defn ex-data [e]
-  (let [e (ex-unwrap e)] (if (ex-info-val? e) (get e :data) nil)))
-(defn ex-message [e]
-  (let [e (ex-unwrap e)]
-    (cond (ex-info-val? e) (get e :message)
-          :else            nil)))
-(defn ex-cause [e]
-  (let [e (ex-unwrap e)] (if (ex-info-val? e) (get e :cause) nil)))
-
-;; inst-ms: epoch milliseconds of an instant; throws on a non-inst (Clojure
-;; protocol behavior).
-(defn inst-ms [x]
-  (if (inst? x) (get x :ms) (throw (str "inst-ms requires an inst, got: " x))))
-
-;; Clojure 1.11 map transformers. PHM base so transformed keys canonicalize
-;; (collisions: last entry in seq order wins, matching the reference).
-(defn update-keys [m f]
-  (reduce-kv (fn [acc k v] (assoc acc (f k) v)) (hash-map) m))
-
-(defn update-vals [m f]
-  (reduce-kv (fn [acc k v] (assoc acc k (f v))) (hash-map) m))
-
-;; Vector-returning partition variants (1.11): lazy seqs OF vectors.
-(defn partitionv
-  ([n coll] (map vec (partition n coll)))
-  ([n step coll] (map vec (partition n step coll)))
-  ([n step pad coll] (map vec (partition n step pad coll))))
-
-;; partition-all is a lazy-tier fn (40-lazy) — declared so partitionv-all
-;; compiles; bound by the time anything calls it.
-(declare partition-all)
-
-(defn partitionv-all
-  ([n coll] (map vec (partition-all n coll)))
-  ([n step coll] (map vec (partition-all n step coll))))
-
-;; First part a vector, rest a seq — matching the reference implementation.
-(defn splitv-at [n coll]
-  [(vec (take n coll)) (drop n coll)])
-
-;; with-redefs-fn: temporarily set each var's root to the mapped value, run
-;; the thunk, restore the saved roots even on throw. The with-redefs macro
-;; (30-macros) builds the {var val} map from names.
-(defn with-redefs-fn [binding-map func]
-  (let [vars (vec (keys binding-map))
-        saved (mapv var-get vars)]
-    (doseq [v vars] (var-set v (get binding-map v)))
-    (try
-      (func)
-      (finally
-        ;; loop/recur, not dotimes: dotimes is a 30-macros macro and this tier
-        ;; compiles before it exists (a forward ref would resolve to the macro
-        ;; fn at runtime and mis-apply it).
-        (loop [i 0]
-          (when (< i (count vars))
-            (var-set (nth vars i) (nth saved i))
-            (recur (inc i))))))))
-;; Jolt has no chunked seqs, so this is always false.
-(defn chunked-seq? [x] false)
-
-;; Atom peripheral operations. atom/swap!/reset!/deref stay native — the compiler
-;; depends on them and they're hot. swap-vals!/reset-vals!/compare-and-set! compose
-;; the native ops (which already validate and notify watches); get-validator reads a
-;; slot; add-watch/remove-watch/set-validator! mutate the atom (or its watches
-;; sub-table) through the one host primitive jolt.host/ref-put! — the minimal
-;; mutation kernel the overlay can't express over core fns (a nil value removes the
-;; key). compare-and-set! compares by value.
-(defn swap-vals! [a f & args]
-  (let [old (deref a)] [old (apply swap! a f args)]))
-(defn reset-vals! [a newval]
-  (let [old (deref a)] (reset! a newval) [old newval]))
-(defn compare-and-set! [a oldval newval]
-  (if (= oldval (deref a)) (do (reset! a newval) true) false))
-(defn get-validator [a] (get a :validator))
-(defn add-watch [a key f]
-  (jolt.host/ref-put! (get a :watches) key f) a)
-(defn remove-watch [a key]
-  (jolt.host/ref-put! (get a :watches) key nil) a)
-(defn set-validator! [a f]
-  (jolt.host/ref-put! a :validator f) nil)
-
-;; vreset!/vswap! live in the seq tier (10-seq.clj): its transducers use them.
-
-;; Future status predicates — pure reads of the future's :cached/:cancelled slots.
-;; future? stays native (deref/future-cancel/realized? call it); future-call and
-;; future-cancel stay native too (OS threads).
-(defn future-done? [x]
-  (if (future? x) (boolean (get x :cached)) (throw "future-done? requires a future")))
-(defn future-cancelled? [x]
-  (and (future? x) (boolean (get x :cancelled))))
-
-;; ns-name: a namespace object's :name as a symbol. Pure over get + symbol.
-(defn ns-name [ns]
-  (let [nm (get ns :name)] (if nm (symbol (str nm)) nil)))
-
-;; Java-array element access. Jolt arrays are mutable backing arrays; aget/alength
-;; read them (nth/count) and aset writes a slot through ref-put!. Both handle the
-;; multi-dimensional form (aget a i j ... / aset a i j ... v) by walking. The array
-;; constructors (object-array/make-array/to-array/...) stay native — they build the
-;; mutable backing.
-(defn aget [arr & idxs]
-  (reduce (fn [v i] (nth v i)) arr idxs))
-(defn alength [arr] (count arr))
-(defn aset [arr & idxs+val]
-  (let [n (count idxs+val)
-        val (nth idxs+val (dec n))
-        target (reduce (fn [t k] (nth t k)) arr (take (- n 2) idxs+val))]
-    (jolt.host/ref-put! target (nth idxs+val (- n 2)) val)
-    val))
-
-;; --- fn combinators + host-free stubs ----------------------------------------
-
-(defn complement
-  "Takes a fn f and returns a fn that takes the same arguments as f, has the
-  same effects, if any, and returns the opposite truth value."
-  [f]
-  (fn [& args] (not (apply f args))))
-
-;; Canonical Clojure fnil: patches only the FIRST 1-3 arguments.
-(defn fnil
-  ([f x]
-   (fn [a & args] (apply f (if (nil? a) x a) args)))
-  ([f x y]
-   (fn [a b & args] (apply f (if (nil? a) x a) (if (nil? b) y b) args)))
-  ([f x y z]
-   (fn [a b c & args]
-     (apply f (if (nil? a) x a) (if (nil? b) y b) (if (nil? c) z c) args))))
-
-(defn clojure-version [] "1.11.0-jolt")
-
-;; bigdec is a host fn (host/chez/bigdec.ss) — a real BigDecimal value type.
-(defn numerator [x] (throw (ex-info "numerator requires a ratio (Jolt has no ratios)" {})))
-(defn denominator [x] (throw (ex-info "denominator requires a ratio (Jolt has no ratios)" {})))
-
-;; No class hierarchy on this host.
-(defn supers [x] #{})
-
-;; Like Clojure's munge: rewrite dashes to underscores, preserving the argument's
-;; type — a symbol munges to a symbol, anything else to a string. (jolt only
-;; rewrites dashes, not the full Compiler CHAR_MAP.)
-(defn munge [s]
-  (let [m (str-replace-all "-" "_" (str s))]
-    (if (symbol? s) (symbol m) m)))
-
-(defn test
-  "Calls the :test fn from v's metadata; :ok if it runs, :no-test if absent."
-  [v]
-  (let [t (:test (meta v))]
-    (if t (do (t) :ok) :no-test)))
-
-;; --- canonical Clojure ports -------------------------------------------------
-;; key/val/find first — merge-with and memoize below use them.
-
-;; Strict, as in Clojure: an entry is what (seq m) yields (a host tuple), NOT
-;; a plain vector — (key [1 2]) throws.
-;; key/val moved above the hierarchies section (underive uses them).
-
-;; find was previously missing from jolt entirely. Presence (contains?), not
-;; value, decides — so (find {:a nil} :a) is [:a nil]. Works on vectors by
-;; index. The result must be a REAL entry (key/val are strict), so it is
-;; minted as the first entry of a one-entry map — nil values survive (the
-;; map builder switches to a phm when nil is involved).
-(defn find [m k]
-  (when (contains? m k) (first {k (get m k)})))
-
-;; some? lives in the top leaf block now (forward refs are errors).
-(defn true? [x] (= true x))
-(defn false? [x] (= false x))
-
-;; Presence-preserving: a key with a nil value is kept ((hash-map) base keeps
-;; nil values and canonicalizes collection keys).
-(defn select-keys [map keyseq]
-  (reduce (fn [m k] (if (contains? map k) (assoc m k (get map k)) m))
-          (hash-map) keyseq))
-
-(defn zipmap [keys vals]
-  (loop [m (hash-map) ks (seq keys) vs (seq vals)]
-    (if (and ks vs)
-      (recur (assoc m (first ks) (first vs)) (next ks) (next vs))
-      m)))
-
-;; conj semantics per entry arg (a map merges, a [k v] pair adds); nil args are
-;; no-ops; all-nil (or no args) is nil.
-(defn merge [& maps]
-  (when (some identity maps)
-    (reduce (fn [acc m] (if (nil? m) acc (conj (or acc (hash-map)) m)))
-            maps)))
-
-(defn merge-with [f & maps]
-  (when (some identity maps)
-    (let [merge-entry (fn [m e]
-                        (let [k (key e) v (val e)]
-                          ;; presence — not nil-of-value — decides combination
-                          (if (contains? m k)
-                            (assoc m k (f (get m k) v))
-                            (assoc m k v))))
-          merge2 (fn [m1 m2]
-                   (reduce merge-entry (or m1 (hash-map)) (seq m2)))]
-      (reduce merge2 maps))))
-
-(defn get-in
-  ([m ks] (reduce get m ks))
-  ([m ks not-found]
-   ;; a fresh table is its own identity — a present-but-nil step is
-   ;; distinguished from a missing one
-   (let [sentinel (hash-map)]
-     (loop [m m ks (seq ks)]
-       (if ks
-         (let [nxt (get m (first ks) sentinel)]
-           (if (identical? sentinel nxt)
-             not-found
-             (recur nxt (next ks))))
-         m)))))
-
-;; find-based, so nil RESULTS are cached too; args canonicalize as a collection key.
-(defn memoize [f]
-  (let [mem (atom (hash-map))]
-    (fn [& args]
-      ;; plain let/if, not if-let: this tier loads before 30-macros defines it
-      (let [e (find (deref mem) args)]
-        (if e
-          (val e)
-          (let [ret (apply f args)]
-            (swap! mem assoc args ret)
-            ret))))))
-
-(defn partial
-  ([f] f)
-  ([f a] (fn [& args] (apply f a args)))
-  ([f a b] (fn [& args] (apply f a b args)))
-  ([f a b c] (fn [& args] (apply f a b c args)))
-  ([f a b c & more] (fn [& args] (apply f a b c (concat more args)))))
-
-(defn trampoline
-  ([f] (let [ret (f)] (if (fn? ret) (trampoline ret) ret)))
-  ([f & args] (trampoline (fn [] (apply f args)))))
-
-;; Canonical pairwise max/min: > / < throw on non-numbers, and the NaN
-;; behavior is Clojure's by construction.
-(defn max
-  ([x] x)
-  ([x y] (if (> x y) x y))
-  ([x y & more] (reduce max (max x y) more)))
-
-(defn min
-  ([x] x)
-  ([x y] (if (< x y) x y))
-  ([x y & more] (reduce min (min x y) more)))
-
-(defn reverse [coll] (reduce conj (list) coll))
-
-;; An empty coll of the same category; sorted colls keep their comparator (the
-;; value's own :empty op). Strings and scalars are nil, as in Clojure; a lazy
-;; seq empties to ().
-(defn empty [coll]
-  (cond
-    (nil? coll) nil
-    (sorted? coll) ((get (jolt.host/ref-get coll :ops) :empty) coll)
-    (map? coll) {}
-    (set? coll) #{}
-    (vector? coll) []
-    (coll? coll) ()
-    :else nil))
-
-(defn assoc-in [m [k & ks] v]
-  (if ks
-    (assoc m k (assoc-in (get m k) ks v))
-    (assoc m k v)))
-
-(defn update-in [m ks f & args]
-  (let [up (fn up [m ks f args]
-             (let [[k & ks] ks]
-               (if ks
-                 (assoc m k (up (get m k) ks f args))
-                 (assoc m k (apply f (get m k) args)))))]
-    (up m ks f args)))
-
-;; jolt keywords have no intern table (any keyword "exists"), so find-keyword
-;; always finds — babashka makes the same call.
-(defn find-keyword
-  ([nm] (keyword nm))
-  ([ns nm] (keyword ns nm)))
-
-;; The raw Inst protocol method; jolt insts have one representation, so it is
-;; inst-ms itself.
-(defn inst-ms* [i] (inst-ms i))
-
-;; Canonical comp — here rather than a host primitive so each stage is invoked with
-;; jolt call semantics: (comp seq :content) works because the keyword stage
-;; goes through IFn dispatch.
-(defn comp
-  ([] identity)
-  ([f] f)
-  ([f g]
-   ;; fixed arities first (Clojure's own shape): the 1-arg path — every
-   ;; map/filter stage — is two direct calls, no rest-seq, no apply.
-   (fn
-     ([] (f (g)))
-     ([x] (f (g x)))
-     ([x y] (f (g x y)))
-     ([x y z] (f (g x y z)))
-     ([x y z & args] (f (apply g x y z args)))))
-  ([f g & fs] (reduce comp (comp f g) fs)))
-
-;; Canonical IFn set: fns, keywords, symbols, maps (sorted incl.),
-;; sets, vectors, and vars — NOT lists ((ifn? '(1 2)) is false in Clojure).
-(defn ifn? [x]
-  (or (fn? x) (keyword? x) (symbol? x) (map? x) (set? x) (vector? x) (var? x)))
-
-;; Auto-promoting (') and unchecked arithmetic. Jolt numbers don't overflow,
-;; so all of these are the checked ops; fixed arities mirror Clojure's
-;; signatures. unchecked-divide-int goes through quot, so dividing by zero
-;; throws as on the JVM.
-(def +' +)
-(def -' -)
-(def *' *)
-(def inc' inc)
-(def dec' dec)
-(defn unchecked-add [x y] (+ x y))
-(defn unchecked-subtract [x y] (- x y))
-(defn unchecked-multiply [x y] (* x y))
-(defn unchecked-negate [x] (- x))
-(defn unchecked-inc [x] (+ x 1))
-(defn unchecked-dec [x] (- x 1))
-(def unchecked-add-int unchecked-add)
-(def unchecked-subtract-int unchecked-subtract)
-(def unchecked-multiply-int unchecked-multiply)
-(def unchecked-negate-int unchecked-negate)
-(def unchecked-inc-int unchecked-inc)
-(def unchecked-dec-int unchecked-dec)
-(defn unchecked-divide-int [x y] (quot x y))
-(defn unchecked-remainder-int [x y] (rem x y))
-(defn unchecked-int [x] (int x))
-(def unchecked-long unchecked-int)
-
-;; int? is integer? on jolt: one number type, so fixed-precision and
-;; arbitrary-precision integers coincide.
-(defn int? [x] (integer? x))
-
-;; num: Clojure coerces to java.lang.Number; jolt just checks.
-(defn num [x]
-  (if (number? x) x (throw (str "num requires a number, got: " x))))
-
-;; == numeric equality: 1-arity is trivially true without inspecting the value
-;; (Clojure's shape); 2+ args must be numbers, as Numbers.equiv throws.
-(defn ==
-  ([x] true)
-  ([x y]
-   (if (and (number? x) (number? y))
-     (= x y)
-     (throw (str "Cannot cast to number: " (if (number? x) y x)))))
-  ([x y & more]
-   (if (== x y)
-     (apply == y more)
-     false)))
-
-;; ensure-reduced / halt-when: canonical Clojure. halt-when smuggles the halt
-;; value through reduce in a ::halt-keyed map and unwraps it in the completion
-;; arity, so the halt REPLACES the whole reduction result.
-(defn ensure-reduced [x] (if (reduced? x) x (reduced x)))
-
-(defn halt-when
-  ([pred] (halt-when pred nil))
-  ([pred retf]
-   (fn [rf]
-     (fn
-       ([] (rf))
-       ([result]
-        (if (and (map? result) (contains? result ::halt))
-          (get result ::halt)
-          (rf result)))
-       ([result input]
-        (if (pred input)
-          (reduced (hash-map ::halt (if retf (retf (rf result) input) input)))
-          (rf result input)))))))
-
-;; parse-boolean: exact "true"/"false" only; nil on anything else, throw on a
-;; non-string (Clojure 1.11).
-(defn parse-boolean [s]
-  (if (string? s)
-    (cond (= s "true") true (= s "false") false :else nil)
-    (throw (str "parse-boolean requires a string, got: " s))))
-
-(defn newline [] (print "\n") nil)
-
-;; seque: jolt is single-threaded eager here — the queue is a no-op and the
-;; coll passes through.
-(defn seque
-  ([s] s)
-  ([n-or-q s] s))
-
-(defn array-seq [arr & _] (seq arr))
-
-(defn to-array-2d [coll] (to-array (map to-array coll)))
-
-;; Masking integer coercions (not aliases): byte/short wrap to their width.
-;; unchecked-byte/short truncate to a number; unchecked-char returns a char (as on
-;; the JVM). int handles chars, so (unchecked-byte \a) works.
-(defn unchecked-byte [x] (bit-and (int x) 0xff))
-(defn unchecked-short [x] (bit-and (int x) 0xffff))
-(defn unchecked-char [x] (char (bit-and (int x) 0xffff)))
-(defn unchecked-float [x] (double x))
-(defn unchecked-double [x] (double x))
-
-;; --- transduce / into / eduction ---------------------------------------------
-;; Canonical transduce: build the stacked rf once, reduce (which honors
-;; `reduced` and steps lazy seqs incrementally), then run the completion arity.
-(defn transduce
-  ([xform f coll] (transduce xform f (f) coll))
-  ([xform f init coll]
-   (let [xf (xform f)]
-     (xf (reduce xf init coll)))))
-
-;; into stays a host primitive: it's perf-wall hot (the into-vec bench pays ~11%
-;; through the overlay call layers — same lesson as even?/odd?).
-
-;; eduction is EAGER on jolt (documented divergence): the composed
-;; xforms applied to coll, realized into a vector.
-(defn eduction [& args]
-  (let [coll (last args)
-        xforms (butlast args)]
-    (if xforms
-      (into [] (apply comp xforms) coll)
-      (into [] coll))))
-
-(defn ->Eduction [xform coll] (into [] xform coll))
-
-;; --- JVM-shape stubs and trivial shells --------------------------------------
-;; Pure compositions or documented jolt stubs; the host keeps nothing.
-(defn enumeration-seq [e] (seq e))
-(defn iterator-seq [i] (seq i))
-
-;; jolt is single-threaded: a promise is an atom, deref never blocks
-;; ((deref undelivered) is nil rather than a hang).
-(defn promise [] (atom nil))
-(defn deliver [p v] (reset! p v) p)
-
-(defn bean [x] (if (map? x) x {}))
-
-(defn uri? [x] false)
-
-;; An EVALUATED set of quoted symbols — a quoted set literal ('#{if ...})
-;; stays an unevaluated reader form on jolt and contains? can't see into it.
-(def ^:private special-syms
-  #{'if 'do 'let* 'fn* 'quote 'var 'def 'loop* 'recur 'throw 'try 'catch
-    'finally 'new 'set! '. 'monitor-enter 'monitor-exit})
-
-(defn special-symbol? [s] (contains? special-syms s))
-
-;; print-method / print-dup are real multimethods in the io tier (50-io.clj).
-
-;; JVM proxies don't exist on this host: the read-only surface is inert,
-;; the constructive surface throws.
-(defn proxy-mappings [p] {})
-(defn proxy-call-with-super [f p meth] (f))
-(defn init-proxy [p mappings] p)
-(defn update-proxy [p mappings] p)
-(defn proxy-super [& args] (throw "proxy-super: JVM proxies are not supported in Jolt"))
-(defn construct-proxy [c & args] (throw "construct-proxy: not supported in Jolt"))
-(defn get-proxy-class [& interfaces] (throw "get-proxy-class: not supported in Jolt"))

jolt-core/clojure/core/21-coll.clj

@@ -0,0 +1,362 @@
+;; clojure.core — collection tier, part 2 (rand/sort host seams, the
+;; clojure.test runner, fn combinators). Continues 20-coll.clj; same constraints
+;; (pure, eager, no macros), loaded in the 20 slot before 25-sorted.
+
+;; --- leaves over the rand / sort host seams ----------------------------------
+
+;; Canonical truncation toward zero via int (the kernel fn floored, which is
+;; wrong for a negative n).
+(defn rand-int [n] (int (rand n)))
+
+;; Pure-functional Fisher-Yates over vector assoc; returns a vector, as in
+;; Clojure. Collections only — a string is seqable but not shuffleable, as on
+;; the JVM (Collections/shuffle wants a Collection).
+(defn shuffle [coll]
+  (when-not (coll? coll)
+    (throw (ex-info (str "shuffle requires a collection, got: " coll) {})))
+  (loop [v (vec coll) i (dec (count v))]
+    (if (pos? i)
+      (let [j (rand-int (inc i))
+            t (nth v i)]
+        (recur (assoc (assoc v i (nth v j)) j t) (dec i)))
+      v)))
+
+;; Canonical sort-by: the default comparator is compare (so nil sorts first,
+;; like Clojure — the kernel fn used host ordering, which put nil last); the
+;; comparator compares KEYS and may be 3-way or a boolean predicate (the host
+;; sort seam normalizes).
+(defn sort-by
+  ([keyfn coll] (sort-by keyfn compare coll))
+  ([keyfn comp coll]
+   (sort (fn [x y] (comp (keyfn x) (keyfn y))) coll)))
+
+;; parse-uuid: nil unless s is a canonical 8-4-4-4-12 hex UUID string; throws
+;; on a non-string (Clojure 1.11). __make-uuid is the host constructor for the
+;; tagged value (overlay source can't write :jolt/type map literals — the
+;; reader treats them as tagged forms).
+(defn parse-uuid [s]
+  (if (string? s)
+    (when (re-matches
+           #"[0-9a-fA-F]{8}-[0-9a-fA-F]{4}-[0-9a-fA-F]{4}-[0-9a-fA-F]{4}-[0-9a-fA-F]{12}" s)
+      (__make-uuid s))
+    (throw (str "parse-uuid requires a string, got: " s))))
+
+;; Version-4 UUID (RFC 4122): zero-padded hex groups 8-4-4-4-12, version
+;; nibble 4, variant 8-b — built over rand-int and validated by parse-uuid.
+(defn random-uuid []
+  (let [hx4 (fn [] (format "%04x" (rand-int 0x10000)))
+        hx3 (fn [] (format "%03x" (rand-int 0x1000)))]
+    (parse-uuid (str (hx4) (hx4) "-" (hx4) "-4" (hx3)
+                     "-" (format "%x" (+ 8 (rand-int 4))) (hx3)
+                     "-" (hx4) (hx4) (hx4)))))
+
+;; The char escape/name tables, as char-keyed maps (Clojure's shape).
+(def ^:private char-escape-strings
+  {\newline "\\n" \tab "\\t" \return "\\r" \formfeed "\\f"
+   \backspace "\\b" \" "\\\"" \\ "\\\\"})
+(defn char-escape-string [c] (get char-escape-strings c))
+
+(def ^:private char-name-strings
+  {\newline "newline" \tab "tab" \return "return" \formfeed "formfeed"
+   \backspace "backspace" \space "space"})
+(defn char-name-string [c] (get char-name-strings c))
+
+;; Random selection over the host rand primitives.
+(defn rand-nth [coll]
+  (let [v (vec coll)] (nth v (rand-int (count v)))))
+
+(defn random-sample
+  ([prob] (filter (fn [_] (< (rand) prob))))
+  ([prob coll] (filter (fn [_] (< (rand) prob)) coll)))
+
+(defn comparator [pred]
+  (fn [a b] (cond (pred a b) -1 (pred b a) 1 :else 0)))
+
+;; Lazy: the running accumulators, one at a time (matches Clojure).
+(defn reductions
+  ([f coll]
+   (lazy-seq
+     (let [s (seq coll)]
+       (if s
+         (reductions f (first s) (rest s))
+         (list (f))))))
+  ([f init coll]
+   (cons init
+         (lazy-seq
+           (when-let [s (seq coll)]
+             (reductions f (f init (first s)) (rest s)))))))
+
+;; Lazy pre-order DFS (matches Clojure): node, then its children's walks spliced
+;; via the (now lazy) mapcat.
+(defn tree-seq [branch? children root]
+  (let [walk (fn walk [node]
+               (lazy-seq
+                 (cons node
+                       (when (branch? node)
+                         (mapcat walk (children node))))))]
+    (walk root)))
+
+;; file-seq: the tree of paths under root (root included), directories walked
+;; via the host dir primitives. Paths (strings), not File objects. (Lives below
+;; tree-seq: forward references are analysis errors.)
+(defn file-seq [root]
+  (if (__file? root)
+    ;; java.io.File tree: walk via the File method surface so leaves are File
+    ;; values callers can invoke .isFile/.getName/slurp on.
+    (tree-seq (fn [f] (.isDirectory f)) (fn [f] (seq (.listFiles f))) root)
+    (tree-seq __dir? __list-dir root)))
+
+;; Canonical flatten via tree-seq: the leaves (non-sequential nodes) in order.
+;; Flattens lists too (sequential?), matching Clojure/CLJS.
+(defn flatten [coll]
+  (filter (complement sequential?) (rest (tree-seq sequential? seq coll))))
+
+;; xml-seq: tree-seq over XML element trees. Elements are maps with :content.
+(defn xml-seq [root]
+  (tree-seq (complement string?) (comp seq :content) root))
+
+;; Lazy interleave: round-robin one element from each coll until any exhausts.
+(defn interleave
+  ([] ())
+  ([c1] (lazy-seq c1))
+  ([c1 c2]
+   (lazy-seq
+     (let [s1 (seq c1) s2 (seq c2)]
+       (when (and s1 s2)
+         (cons (first s1)
+               (cons (first s2)
+                     (interleave (rest s1) (rest s2))))))))
+  ([c1 c2 & cs]
+   (lazy-seq
+     (let [ss (map seq (list* c1 c2 cs))]
+       (when (every? identity ss)
+         (concat (map first ss)
+                 (apply interleave (map rest ss))))))))
+
+;; No ratio type on Jolt, so rationalize is identity.
+(defn rationalize [x] x)
+
+;; 0-arg: a stateful transducer (tracks [seen? prev] in a volatile, so no sentinel
+;; value is needed). 1-arg: eager dedupe of consecutive equal elements.
+(defn dedupe
+  ([]
+   (fn [rf]
+     (let [pv (volatile! [false nil])]
+       (fn
+         ([] (rf))
+         ([result] (rf result))
+         ([result input]
+          (let [[seen prior] @pv]
+            (vreset! pv [true input])
+            (if (and seen (= prior input)) result (rf result input))))))))
+  ([coll]
+   (let [step (fn step [s prev]
+                (make-lazy-seq
+                  (fn* []
+                    (let [s (seq s)]
+                      (if s
+                        (let [x (first s)]
+                          (if (= x prev)
+                            (coll->cells (step (rest s) prev))
+                            (coll->cells (cons x (step (rest s) x)))))
+                        nil)))))]
+     (let [s (seq coll)]
+       (if s
+         (make-lazy-seq
+           (fn* [] (coll->cells (cons (first s) (step (rest s) (first s))))))
+         ())))))
+
+;; Internal helper for {:keys [...]} destructuring over a seq of k/v pairs —
+;; canonical Clojure 1.11 shape (core.clj seq-to-map-for-destructuring):
+;; even pairs build a map (later keys win, as createAsIfByAssoc), a SINGLE
+;; element is returned as-is (the trailing-map calling convention), and an
+;; unpaired key past pairs throws.
+(defn seq-to-map-for-destructuring [s]
+  (if (next s)
+    (loop [m {} xs (seq s)]
+      (if xs
+        (if (next xs)
+          (recur (assoc m (first xs) (second xs)) (nnext xs))
+          (throw (str "No value supplied for key: " (first xs))))
+        m))
+    (if (seq s) (first s) {})))
+
+;; Host-coupled fns that are pure logic over existing core primitives, so they
+;; need no new jolt.host surface.
+
+;; vary-meta: f applied to obj's metadata (+ extra args), reattached. meta and
+;; with-meta are the irreducible host primitives; vary-meta is just their compose.
+(defn vary-meta [obj f & args]
+  (with-meta obj (apply f (meta obj) args)))
+
+;; namespace-munge: Clojure namespace name -> legal Java package name (- -> _).
+(defn namespace-munge [s]
+  (apply str (map (fn [c] (if (= c \-) \_ c)) (seq (str s)))))
+
+;; reduce-kv over a map (k v) or vector (index v). Both branches go through reduce,
+;; so reduced short-circuits — and the vector path indexes correctly. nil folds
+;; to init, matching Clojure.
+(defn reduce-kv [f init coll]
+  (cond
+    (vector? coll) (reduce (fn [acc i] (f acc i (nth coll i))) init (range (count coll)))
+    (map? coll)    (reduce (fn [acc k] (f acc k (get coll k))) init (keys coll))
+    (nil? coll)    init
+    :else (throw (str "reduce-kv not supported on: " coll))))
+
+;; ex-info accessors. The constructor (ex-info) stays native — it builds the tagged
+;; value and wires into throw — but the value exposes :jolt/type/:message/:data/
+;; :cause via get, so the accessors are pure over get. A thrown non-ex-info arrives
+;; wrapped as {:jolt/type :jolt/exception :value v}; unwrap that first.
+(defn- ex-info-val? [x] (= (get x :jolt/type) :jolt/ex-info))
+(defn- ex-unwrap [e]
+  (if (= (get e :jolt/type) :jolt/exception) (get e :value) e))
+(defn ex-data [e]
+  (let [e (ex-unwrap e)] (if (ex-info-val? e) (get e :data) nil)))
+(defn ex-message [e]
+  (let [e (ex-unwrap e)]
+    (cond (ex-info-val? e) (get e :message)
+          :else            nil)))
+(defn ex-cause [e]
+  (let [e (ex-unwrap e)] (if (ex-info-val? e) (get e :cause) nil)))
+
+;; inst-ms: epoch milliseconds of an instant; throws on a non-inst (Clojure
+;; protocol behavior).
+(defn inst-ms [x]
+  (if (inst? x) (get x :ms) (throw (str "inst-ms requires an inst, got: " x))))
+
+;; Clojure 1.11 map transformers. PHM base so transformed keys canonicalize
+;; (collisions: last entry in seq order wins, matching the reference).
+(defn update-keys [m f]
+  (reduce-kv (fn [acc k v] (assoc acc (f k) v)) (hash-map) m))
+
+(defn update-vals [m f]
+  (reduce-kv (fn [acc k v] (assoc acc k (f v))) (hash-map) m))
+
+;; Vector-returning partition variants (1.11): lazy seqs OF vectors.
+(defn partitionv
+  ([n coll] (map vec (partition n coll)))
+  ([n step coll] (map vec (partition n step coll)))
+  ([n step pad coll] (map vec (partition n step pad coll))))
+
+;; partition-all is a lazy-tier fn (40-lazy) — declared so partitionv-all
+;; compiles; bound by the time anything calls it.
+(declare partition-all)
+
+(defn partitionv-all
+  ([n coll] (map vec (partition-all n coll)))
+  ([n step coll] (map vec (partition-all n step coll))))
+
+;; First part a vector, rest a seq — matching the reference implementation.
+(defn splitv-at [n coll]
+  [(vec (take n coll)) (drop n coll)])
+
+;; with-redefs-fn: temporarily set each var's root to the mapped value, run
+;; the thunk, restore the saved roots even on throw. The with-redefs macro
+;; (30-macros) builds the {var val} map from names.
+(defn with-redefs-fn [binding-map func]
+  (let [vars (vec (keys binding-map))
+        saved (mapv var-get vars)]
+    (doseq [v vars] (var-set v (get binding-map v)))
+    (try
+      (func)
+      (finally
+        ;; loop/recur, not dotimes: dotimes is a 30-macros macro and this tier
+        ;; compiles before it exists (a forward ref would resolve to the macro
+        ;; fn at runtime and mis-apply it).
+        (loop [i 0]
+          (when (< i (count vars))
+            (var-set (nth vars i) (nth saved i))
+            (recur (inc i))))))))
+;; Jolt has no chunked seqs, so this is always false.
+(defn chunked-seq? [x] false)
+
+;; Atom peripheral operations. atom/swap!/reset!/deref stay native — the compiler
+;; depends on them and they're hot. swap-vals!/reset-vals!/compare-and-set! compose
+;; the native ops (which already validate and notify watches); get-validator reads a
+;; slot; add-watch/remove-watch/set-validator! mutate the atom (or its watches
+;; sub-table) through the one host primitive jolt.host/ref-put! — the minimal
+;; mutation kernel the overlay can't express over core fns (a nil value removes the
+;; key). compare-and-set! compares by value.
+(defn swap-vals! [a f & args]
+  (let [old (deref a)] [old (apply swap! a f args)]))
+(defn reset-vals! [a newval]
+  (let [old (deref a)] (reset! a newval) [old newval]))
+(defn compare-and-set! [a oldval newval]
+  (if (= oldval (deref a)) (do (reset! a newval) true) false))
+(defn get-validator [a] (get a :validator))
+(defn add-watch [a key f]
+  (jolt.host/ref-put! (get a :watches) key f) a)
+(defn remove-watch [a key]
+  (jolt.host/ref-put! (get a :watches) key nil) a)
+(defn set-validator! [a f]
+  (jolt.host/ref-put! a :validator f) nil)
+
+;; vreset!/vswap! live in the seq tier (10-seq.clj): its transducers use them.
+
+;; Future status predicates — pure reads of the future's :cached/:cancelled slots.
+;; future? stays native (deref/future-cancel/realized? call it); future-call and
+;; future-cancel stay native too (OS threads).
+(defn future-done? [x]
+  (if (future? x) (boolean (get x :cached)) (throw "future-done? requires a future")))
+(defn future-cancelled? [x]
+  (and (future? x) (boolean (get x :cancelled))))
+
+;; ns-name: a namespace object's :name as a symbol. Pure over get + symbol.
+(defn ns-name [ns]
+  (let [nm (get ns :name)] (if nm (symbol (str nm)) nil)))
+
+;; Java-array element access. Jolt arrays are mutable backing arrays; aget/alength
+;; read them (nth/count) and aset writes a slot through ref-put!. Both handle the
+;; multi-dimensional form (aget a i j ... / aset a i j ... v) by walking. The array
+;; constructors (object-array/make-array/to-array/...) stay native — they build the
+;; mutable backing.
+(defn aget [arr & idxs]
+  (reduce (fn [v i] (nth v i)) arr idxs))
+(defn alength [arr] (count arr))
+(defn aset [arr & idxs+val]
+  (let [n (count idxs+val)
+        val (nth idxs+val (dec n))
+        target (reduce (fn [t k] (nth t k)) arr (take (- n 2) idxs+val))]
+    (jolt.host/ref-put! target (nth idxs+val (- n 2)) val)
+    val))
+
+;; --- fn combinators + host-free stubs ----------------------------------------
+
+(defn complement
+  "Takes a fn f and returns a fn that takes the same arguments as f, has the
+  same effects, if any, and returns the opposite truth value."
+  [f]
+  (fn [& args] (not (apply f args))))
+
+;; Canonical Clojure fnil: patches only the FIRST 1-3 arguments.
+(defn fnil
+  ([f x]
+   (fn [a & args] (apply f (if (nil? a) x a) args)))
+  ([f x y]
+   (fn [a b & args] (apply f (if (nil? a) x a) (if (nil? b) y b) args)))
+  ([f x y z]
+   (fn [a b c & args]
+     (apply f (if (nil? a) x a) (if (nil? b) y b) (if (nil? c) z c) args))))
+
+(defn clojure-version [] "1.11.0-jolt")
+
+;; bigdec is a host fn (host/chez/bigdec.ss) — a real BigDecimal value type.
+(defn numerator [x] (throw (ex-info "numerator requires a ratio (Jolt has no ratios)" {})))
+(defn denominator [x] (throw (ex-info "denominator requires a ratio (Jolt has no ratios)" {})))
+
+;; No class hierarchy on this host.
+(defn supers [x] #{})
+
+;; Like Clojure's munge: rewrite dashes to underscores, preserving the argument's
+;; type — a symbol munges to a symbol, anything else to a string. (jolt only
+;; rewrites dashes, not the full Compiler CHAR_MAP.)
+(defn munge [s]
+  (let [m (str-replace-all "-" "_" (str s))]
+    (if (symbol? s) (symbol m) m)))
+
+(defn test
+  "Calls the :test fn from v's metadata; :ok if it runs, :no-test if absent."
+  [v]
+  (let [t (:test (meta v))]
+    (if t (do (t) :ok) :no-test)))
+

jolt-core/clojure/core/22-coll.clj

@@ -0,0 +1,314 @@
+;; clojure.core — collection tier, part 3 (canonical Clojure ports: key/val/find,
+;; merge-with, memoize, group-by, frequencies, transduce/into/eduction, and the
+;; JVM-shape stubs). Continues 21-coll.clj; same constraints.
+
+;; --- canonical Clojure ports -------------------------------------------------
+;; key/val/find first — merge-with and memoize below use them.
+
+;; Strict, as in Clojure: an entry is what (seq m) yields (a host tuple), NOT
+;; a plain vector — (key [1 2]) throws.
+;; key/val moved above the hierarchies section (underive uses them).
+
+;; find was previously missing from jolt entirely. Presence (contains?), not
+;; value, decides — so (find {:a nil} :a) is [:a nil]. Works on vectors by
+;; index. The result must be a REAL entry (key/val are strict), so it is
+;; minted as the first entry of a one-entry map — nil values survive (the
+;; map builder switches to a phm when nil is involved).
+(defn find [m k]
+  (when (contains? m k) (first {k (get m k)})))
+
+;; some? lives in the top leaf block now (forward refs are errors).
+(defn true? [x] (= true x))
+(defn false? [x] (= false x))
+
+;; Presence-preserving: a key with a nil value is kept ((hash-map) base keeps
+;; nil values and canonicalizes collection keys).
+(defn select-keys [map keyseq]
+  (reduce (fn [m k] (if (contains? map k) (assoc m k (get map k)) m))
+          (hash-map) keyseq))
+
+(defn zipmap [keys vals]
+  (loop [m (hash-map) ks (seq keys) vs (seq vals)]
+    (if (and ks vs)
+      (recur (assoc m (first ks) (first vs)) (next ks) (next vs))
+      m)))
+
+;; conj semantics per entry arg (a map merges, a [k v] pair adds); nil args are
+;; no-ops; all-nil (or no args) is nil.
+(defn merge [& maps]
+  (when (some identity maps)
+    (reduce (fn [acc m] (if (nil? m) acc (conj (or acc (hash-map)) m)))
+            maps)))
+
+(defn merge-with [f & maps]
+  (when (some identity maps)
+    (let [merge-entry (fn [m e]
+                        (let [k (key e) v (val e)]
+                          ;; presence — not nil-of-value — decides combination
+                          (if (contains? m k)
+                            (assoc m k (f (get m k) v))
+                            (assoc m k v))))
+          merge2 (fn [m1 m2]
+                   (reduce merge-entry (or m1 (hash-map)) (seq m2)))]
+      (reduce merge2 maps))))
+
+(defn get-in
+  ([m ks] (reduce get m ks))
+  ([m ks not-found]
+   ;; a fresh table is its own identity — a present-but-nil step is
+   ;; distinguished from a missing one
+   (let [sentinel (hash-map)]
+     (loop [m m ks (seq ks)]
+       (if ks
+         (let [nxt (get m (first ks) sentinel)]
+           (if (identical? sentinel nxt)
+             not-found
+             (recur nxt (next ks))))
+         m)))))
+
+;; find-based, so nil RESULTS are cached too; args canonicalize as a collection key.
+(defn memoize [f]
+  (let [mem (atom (hash-map))]
+    (fn [& args]
+      ;; plain let/if, not if-let: this tier loads before 30-macros defines it
+      (let [e (find (deref mem) args)]
+        (if e
+          (val e)
+          (let [ret (apply f args)]
+            (swap! mem assoc args ret)
+            ret))))))
+
+(defn partial
+  ([f] f)
+  ([f a] (fn [& args] (apply f a args)))
+  ([f a b] (fn [& args] (apply f a b args)))
+  ([f a b c] (fn [& args] (apply f a b c args)))
+  ([f a b c & more] (fn [& args] (apply f a b c (concat more args)))))
+
+(defn trampoline
+  ([f] (let [ret (f)] (if (fn? ret) (trampoline ret) ret)))
+  ([f & args] (trampoline (fn [] (apply f args)))))
+
+;; Canonical pairwise max/min: > / < throw on non-numbers, and the NaN
+;; behavior is Clojure's by construction.
+(defn max
+  ([x] x)
+  ([x y] (if (> x y) x y))
+  ([x y & more] (reduce max (max x y) more)))
+
+(defn min
+  ([x] x)
+  ([x y] (if (< x y) x y))
+  ([x y & more] (reduce min (min x y) more)))
+
+(defn reverse [coll] (reduce conj (list) coll))
+
+;; An empty coll of the same category; sorted colls keep their comparator (the
+;; value's own :empty op). Strings and scalars are nil, as in Clojure; a lazy
+;; seq empties to ().
+(defn empty [coll]
+  (cond
+    (nil? coll) nil
+    (sorted? coll) ((get (jolt.host/ref-get coll :ops) :empty) coll)
+    (map? coll) {}
+    (set? coll) #{}
+    (vector? coll) []
+    (coll? coll) ()
+    :else nil))
+
+(defn assoc-in [m [k & ks] v]
+  (if ks
+    (assoc m k (assoc-in (get m k) ks v))
+    (assoc m k v)))
+
+(defn update-in [m ks f & args]
+  (let [up (fn up [m ks f args]
+             (let [[k & ks] ks]
+               (if ks
+                 (assoc m k (up (get m k) ks f args))
+                 (assoc m k (apply f (get m k) args)))))]
+    (up m ks f args)))
+
+;; jolt keywords have no intern table (any keyword "exists"), so find-keyword
+;; always finds — babashka makes the same call.
+(defn find-keyword
+  ([nm] (keyword nm))
+  ([ns nm] (keyword ns nm)))
+
+;; The raw Inst protocol method; jolt insts have one representation, so it is
+;; inst-ms itself.
+(defn inst-ms* [i] (inst-ms i))
+
+;; Canonical comp — here rather than a host primitive so each stage is invoked with
+;; jolt call semantics: (comp seq :content) works because the keyword stage
+;; goes through IFn dispatch.
+(defn comp
+  ([] identity)
+  ([f] f)
+  ([f g]
+   ;; fixed arities first (Clojure's own shape): the 1-arg path — every
+   ;; map/filter stage — is two direct calls, no rest-seq, no apply.
+   (fn
+     ([] (f (g)))
+     ([x] (f (g x)))
+     ([x y] (f (g x y)))
+     ([x y z] (f (g x y z)))
+     ([x y z & args] (f (apply g x y z args)))))
+  ([f g & fs] (reduce comp (comp f g) fs)))
+
+;; Canonical IFn set: fns, keywords, symbols, maps (sorted incl.),
+;; sets, vectors, and vars — NOT lists ((ifn? '(1 2)) is false in Clojure).
+(defn ifn? [x]
+  (or (fn? x) (keyword? x) (symbol? x) (map? x) (set? x) (vector? x) (var? x)))
+
+;; Auto-promoting (') and unchecked arithmetic. Jolt numbers don't overflow,
+;; so all of these are the checked ops; fixed arities mirror Clojure's
+;; signatures. unchecked-divide-int goes through quot, so dividing by zero
+;; throws as on the JVM.
+(def +' +)
+(def -' -)
+(def *' *)
+(def inc' inc)
+(def dec' dec)
+(defn unchecked-add [x y] (+ x y))
+(defn unchecked-subtract [x y] (- x y))
+(defn unchecked-multiply [x y] (* x y))
+(defn unchecked-negate [x] (- x))
+(defn unchecked-inc [x] (+ x 1))
+(defn unchecked-dec [x] (- x 1))
+(def unchecked-add-int unchecked-add)
+(def unchecked-subtract-int unchecked-subtract)
+(def unchecked-multiply-int unchecked-multiply)
+(def unchecked-negate-int unchecked-negate)
+(def unchecked-inc-int unchecked-inc)
+(def unchecked-dec-int unchecked-dec)
+(defn unchecked-divide-int [x y] (quot x y))
+(defn unchecked-remainder-int [x y] (rem x y))
+(defn unchecked-int [x] (int x))
+(def unchecked-long unchecked-int)
+
+;; int? is integer? on jolt: one number type, so fixed-precision and
+;; arbitrary-precision integers coincide.
+(defn int? [x] (integer? x))
+
+;; num: Clojure coerces to java.lang.Number; jolt just checks.
+(defn num [x]
+  (if (number? x) x (throw (str "num requires a number, got: " x))))
+
+;; == numeric equality: 1-arity is trivially true without inspecting the value
+;; (Clojure's shape); 2+ args must be numbers, as Numbers.equiv throws.
+(defn ==
+  ([x] true)
+  ([x y]
+   (if (and (number? x) (number? y))
+     (= x y)
+     (throw (str "Cannot cast to number: " (if (number? x) y x)))))
+  ([x y & more]
+   (if (== x y)
+     (apply == y more)
+     false)))
+
+;; ensure-reduced / halt-when: canonical Clojure. halt-when smuggles the halt
+;; value through reduce in a ::halt-keyed map and unwraps it in the completion
+;; arity, so the halt REPLACES the whole reduction result.
+(defn ensure-reduced [x] (if (reduced? x) x (reduced x)))
+
+(defn halt-when
+  ([pred] (halt-when pred nil))
+  ([pred retf]
+   (fn [rf]
+     (fn
+       ([] (rf))
+       ([result]
+        (if (and (map? result) (contains? result ::halt))
+          (get result ::halt)
+          (rf result)))
+       ([result input]
+        (if (pred input)
+          (reduced (hash-map ::halt (if retf (retf (rf result) input) input)))
+          (rf result input)))))))
+
+;; parse-boolean: exact "true"/"false" only; nil on anything else, throw on a
+;; non-string (Clojure 1.11).
+(defn parse-boolean [s]
+  (if (string? s)
+    (cond (= s "true") true (= s "false") false :else nil)
+    (throw (str "parse-boolean requires a string, got: " s))))
+
+(defn newline [] (print "\n") nil)
+
+;; seque: jolt is single-threaded eager here — the queue is a no-op and the
+;; coll passes through.
+(defn seque
+  ([s] s)
+  ([n-or-q s] s))
+
+(defn array-seq [arr & _] (seq arr))
+
+(defn to-array-2d [coll] (to-array (map to-array coll)))
+
+;; Masking integer coercions (not aliases): byte/short wrap to their width.
+;; unchecked-byte/short truncate to a number; unchecked-char returns a char (as on
+;; the JVM). int handles chars, so (unchecked-byte \a) works.
+(defn unchecked-byte [x] (bit-and (int x) 0xff))
+(defn unchecked-short [x] (bit-and (int x) 0xffff))
+(defn unchecked-char [x] (char (bit-and (int x) 0xffff)))
+(defn unchecked-float [x] (double x))
+(defn unchecked-double [x] (double x))
+
+;; --- transduce / into / eduction ---------------------------------------------
+;; Canonical transduce: build the stacked rf once, reduce (which honors
+;; `reduced` and steps lazy seqs incrementally), then run the completion arity.
+(defn transduce
+  ([xform f coll] (transduce xform f (f) coll))
+  ([xform f init coll]
+   (let [xf (xform f)]
+     (xf (reduce xf init coll)))))
+
+;; into stays a host primitive: it's perf-wall hot (the into-vec bench pays ~11%
+;; through the overlay call layers — same lesson as even?/odd?).
+
+;; eduction is EAGER on jolt (documented divergence): the composed
+;; xforms applied to coll, realized into a vector.
+(defn eduction [& args]
+  (let [coll (last args)
+        xforms (butlast args)]
+    (if xforms
+      (into [] (apply comp xforms) coll)
+      (into [] coll))))
+
+(defn ->Eduction [xform coll] (into [] xform coll))
+
+;; --- JVM-shape stubs and trivial shells --------------------------------------
+;; Pure compositions or documented jolt stubs; the host keeps nothing.
+(defn enumeration-seq [e] (seq e))
+(defn iterator-seq [i] (seq i))
+
+;; jolt is single-threaded: a promise is an atom, deref never blocks
+;; ((deref undelivered) is nil rather than a hang).
+(defn promise [] (atom nil))
+(defn deliver [p v] (reset! p v) p)
+
+(defn bean [x] (if (map? x) x {}))
+
+(defn uri? [x] false)
+
+;; An EVALUATED set of quoted symbols — a quoted set literal ('#{if ...})
+;; stays an unevaluated reader form on jolt and contains? can't see into it.
+(def ^:private special-syms
+  #{'if 'do 'let* 'fn* 'quote 'var 'def 'loop* 'recur 'throw 'try 'catch
+    'finally 'new 'set! '. 'monitor-enter 'monitor-exit})
+
+(defn special-symbol? [s] (contains? special-syms s))
+
+;; print-method / print-dup are real multimethods in the io tier (50-io.clj).
+
+;; JVM proxies don't exist on this host: the read-only surface is inert,
+;; the constructive surface throws.
+(defn proxy-mappings [p] {})
+(defn proxy-call-with-super [f p meth] (f))
+(defn init-proxy [p mappings] p)
+(defn update-proxy [p mappings] p)
+(defn proxy-super [& args] (throw "proxy-super: JVM proxies are not supported in Jolt"))
+(defn construct-proxy [c & args] (throw "construct-proxy: not supported in Jolt"))
+(defn get-proxy-class [& interfaces] (throw "get-proxy-class: not supported in Jolt"))

jolt-core/clojure/core/40-lazy.clj

@@ -76,13 +76,11 @@
      (mapi 0 coll))))
 
 ;; --- cycle ---
+;; Lazy, like the JVM: never counts coll, so it terminates on a lazy/infinite
+;; argument instead of forcing it.
 (defn cycle [coll]
-  (if-let [vals (seq coll)]
-    (let [n (count vals)]
-      (letfn [(cstep [i]
-                (lazy-seq
-                  (cons (nth vals (mod i n)) (cstep (inc i)))))]
-        (cstep 0)))
+  (if (seq coll)
+    (lazy-seq (concat coll (cycle coll)))
     ()))
 
 ;; --- repeatedly --- ((f) throws on a non-fn; (take n …) throws on a non-number

jolt-core/jolt/analyzer.clj

@@ -32,6 +32,10 @@
 
 (declare analyze)
 
+;; Special forms analyze-special has a dispatch arm for — the subset of the host
+;; contract's reserved words (jolt.host/form-special?) the analyzer lowers itself.
+;; The two differ deliberately (e.g. interop heads like `new`/`.` are reserved but
+;; analyzed in analyze-list), so keep them in sync by intent, not by equality.
 (def ^:private handled
   #{"quote" "if" "do" "def" "fn*" "let*" "loop*" "recur" "throw" "try"
     "syntax-quote" "var" "letfn" "set!" "defmacro"})
@@ -251,6 +255,65 @@
     {:op :let :letrec true :bindings binds
      :body (analyze-seq ctx (drop 2 items) env*)}))
 
+;; A `.-field` head: `(.-field target)` is field access (the dash signals field
+;; access to the host-call dispatcher). Defined above analyze-special so its set!
+;; arm and analyze-list both reach it without a forward reference.
+(defn- field-head? [nm]
+  (and (> (count nm) 2) (= ".-" (subs nm 0 2))))
+
+(defn- analyze-def [ctx items env]
+  (let [name-sym (nth items 1)]
+    ;; ^{:map} metadata reads as (def (with-meta name m) v): the metadata is a
+    ;; runtime expression, so the interpreter evaluates the whole def.
+    (when-not (form-sym? name-sym)
+      (uncompilable "def name with map metadata"))
+    (if (< (count items) 3)
+      ;; (def name) with no init (declare): intern + reserve the cell so a forward
+      ;; reference resolves; the back end keys on :no-init.
+      (let [nm (form-sym-name name-sym) cur (compile-ns ctx)]
+        (host-intern! ctx cur nm)
+        {:op :def :ns cur :name nm :no-init true})
+      ;; (def name docstring value): docstring is form 2, value form 3 — matching
+      ;; the interpreter, else the docstring is taken as the value.
+      (let [nm (form-sym-name name-sym)
+            cur (compile-ns ctx)
+            has-doc (and (> (count items) 3) (string? (nth items 2)))
+            val-form (nth items (if has-doc 3 2))
+            base0 (or (form-sym-meta name-sym) {})
+            ;; resolve a ^Type hint to its canonical class name at def time, as the
+            ;; JVM compiler does (^String -> java.lang.String); unknown hints pass.
+            tag (get base0 :tag)
+            tag-name (cond (form-sym? tag) (form-sym-name tag)
+                           (string? tag) tag
+                           :else nil)
+            base-meta (if tag-name
+                        (let [c (resolve-class-hint tag-name)]
+                          (if c (assoc base0 :tag c) base0))
+                        base0)
+            node-meta (if has-doc (assoc base-meta :doc (nth items 2)) base-meta)]
+        (host-intern! ctx cur nm)
+        (def-node cur nm (analyze ctx val-form env) node-meta)))))
+
+;; (set! (.-field obj) v) mutates a deftype instance field in place; (set! *var* v)
+;; sets the var's innermost thread binding, else its root. A local target (jolt
+;; binds fields immutably) or any other shape is uncompilable.
+(defn- analyze-set! [ctx items env]
+  (let [target (nth items 1)
+        val-node (analyze ctx (nth items 2) env)
+        ti (when (form-list? target) (vec (form-elements target)))
+        thead (when (and ti (pos? (count ti)) (form-sym? (first ti)))
+                (form-sym-name (first ti)))]
+    (cond
+      (and thead (field-head? thead))
+      {:op :set-field :obj (analyze ctx (nth ti 1) env)
+       :field (subs thead 2) :val val-node}
+      (form-sym? target)
+      (do (when (local? env (form-sym-name target)) (uncompilable "set! of a local"))
+          (let [r (resolve-global ctx target)]
+            (when-not (= :var (:kind r)) (uncompilable "set! of a non-var"))
+            {:op :set-var :the-var (the-var (:ns r) (:name r)) :val val-node}))
+      :else (uncompilable "set! of an unsupported target"))))
+
 (defn- analyze-special [ctx op items env]
   (case op
     "quote" (quote-node (second items))
@@ -265,42 +328,7 @@
                       (const nil))))
     "do" (analyze-seq ctx (rest items) env)
     "throw" (throw-node (analyze ctx (nth items 1) env))
-    "def" (let [name-sym (nth items 1)]
-            ;; ^{:map} metadata reads as (def (with-meta name m) v) — the
-            ;; metadata is a runtime expression, so the interpreter evaluates
-            ;; the whole def (it unwraps the name and merges the meta).
-            (when-not (form-sym? name-sym)
-              (uncompilable "def name with map metadata"))
-            (if (< (count items) 3)
-              ;; (def name) with no init (declare): intern + reserve the cell so a
-              ;; forward reference resolves. The back end keys on :no-init — Chez
-              ;; def-var!s an unbound placeholder; the interpreter interns a
-              ;; genuinely-unbound var.
-              (let [nm (form-sym-name name-sym) cur (compile-ns ctx)]
-                (host-intern! ctx cur nm)
-                {:op :def :ns cur :name nm :no-init true})
-              (let [nm (form-sym-name name-sym)
-                    cur (compile-ns ctx)
-                    ;; (def name docstring value): docstring is form 2, value form 3.
-                    ;; Matches the interpreter; otherwise the docstring is taken as
-                    ;; the value and the real init dropped.
-                    has-doc (and (> (count items) 3) (string? (nth items 2)))
-                    val-form (nth items (if has-doc 3 2))
-                    base0 (or (form-sym-meta name-sym) {})
-                    ;; resolve a ^Type hint to its canonical class name at def
-                    ;; time, as the JVM compiler does: ^String ->
-                    ;; java.lang.String. A record/unknown hint is left untouched.
-                    tag (get base0 :tag)
-                    tag-name (cond (form-sym? tag) (form-sym-name tag)
-                                   (string? tag) tag
-                                   :else nil)
-                    base-meta (if tag-name
-                                (let [c (resolve-class-hint tag-name)]
-                                  (if c (assoc base0 :tag c) base0))
-                                base0)
-                    node-meta (if has-doc (assoc base-meta :doc (nth items 2)) base-meta)]
-                (host-intern! ctx cur nm)
-                (def-node cur nm (analyze ctx val-form env) node-meta))))
+    "def" (analyze-def ctx items env)
     "let*" (let [bvec (vec (form-vec-items (nth items 1)))
                  r (analyze-bindings ctx bvec env)]
              (let-node (first r) (analyze-seq ctx (drop 2 items) (second r))))
@@ -345,24 +373,7 @@
                  (host-intern! ctx cur nm)
                  {:op :defmacro :ns cur :name nm
                   :fn (analyze ctx fn-form env)})
-    "set!" (let [target (nth items 1)
-                 val-node (analyze ctx (nth items 2) env)
-                 ti (when (form-list? target) (vec (form-elements target)))
-                 thead (when (and ti (pos? (count ti)) (form-sym? (first ti)))
-                         (form-sym-name (first ti)))]
-             (cond
-               ;; (set! (.-field obj) v): mutate a deftype instance field in place.
-               ;; A deftype method's (set! mutable-field v) lowers to this shape.
-               (and thead (field-head? thead))
-               {:op :set-field :obj (analyze ctx (nth ti 1) env)
-                :field (subs thead 2) :val val-node}
-               ;; (set! *var* v): set the var's innermost binding, else its root.
-               (form-sym? target)
-               (do (when (local? env (form-sym-name target)) (uncompilable "set! of a local"))
-                   (let [r (resolve-global ctx target)]
-                     (when-not (= :var (:kind r)) (uncompilable "set! of a non-var"))
-                     {:op :set-var :the-var (the-var (:ns r) (:name r)) :val val-node}))
-               :else (uncompilable "set! of an unsupported target")))
+    "set!" (analyze-set! ctx items env)
     (uncompilable (str "special form " op))))
 
 ;; Host interop method call. `(.method target arg*)` — a head that
@@ -433,11 +444,6 @@
         (invoke (analyze ctx member env) [(analyze ctx (nth items 1) env)])
       :else (uncompilable "special form . (non-symbol member)"))))
 
-;; A `.-field` head: `(.-field target)` is field access. Lowers to a :host-call
-;; with the "-field" method (the dash signals field access to the dispatcher).
-(defn- field-head? [nm]
-  (and (> (count nm) 2) (= ".-" (subs nm 0 2))))
-
 (defn- analyze-field [ctx hname items env]
   (when (< (count items) 2)
     (throw (str "Malformed (.-field target) form")))

jolt-core/jolt/backend_scheme.clj

@@ -210,10 +210,12 @@
        (str/join " " (mapcat (fn [p] [(emit-quoted (nth p 0)) (emit-quoted (nth p 1))]) pairs))
        ")"))
 (defn- emit-quoted-map-value [m]
-  ;; a jolt map VALUE (def/symbol metadata is a value, not a reader form)
-  (str "(jolt-hash-map "
-       (str/join " " (mapcat (fn [k] [(emit-quoted k) (emit-quoted (get m k))]) (keys m)))
-       ")"))
+  ;; A jolt map VALUE (def/symbol metadata is a value, not a reader form). (keys m)
+  ;; iterates in host-hash order, which is not stable across Chez versions, so emit
+  ;; the pairs sorted by their emitted Scheme text — keeps the seed byte-fixed
+  ;; regardless of the host hash (jolt-8479).
+  (let [pairs (sort (map (fn [k] (str (emit-quoted k) " " (emit-quoted (get m k)))) (keys m)))]
+    (str "(jolt-hash-map " (str/join " " pairs) ")")))
 ;; emit-quoted reconstructs both raw reader forms (from :quote) AND plain jolt
 ;; values (def/symbol :meta). Reader forms are walked via the jolt.host form-*
 ;; contract; the native-predicate branches below catch genuine jolt collection
@@ -230,14 +232,16 @@
         (str "(jolt-symbol/meta " (if sns (chez-str-lit sns) "#f") " " (chez-str-lit nm) " "
              (emit-quoted m) ")")
         (str "(jolt-symbol " (if sns (chez-str-lit sns) "#f") " " (chez-str-lit nm) ")")))
-    (form-set? form) (str "(jolt-hash-set " (str/join " " (map emit-quoted (form-set-items form))) ")")
+    ;; sort items by emitted text: a set has no source order, and host-hash order
+    ;; is not stable across Chez versions (jolt-8479).
+    (form-set? form) (str "(jolt-hash-set " (str/join " " (sort (map emit-quoted (form-set-items form)))) ")")
     (form-list? form) (str "(jolt-list " (str/join " " (map emit-quoted (form-elements form))) ")")
     (form-vec? form) (str "(jolt-vector " (str/join " " (map emit-quoted (form-vec-items form))) ")")
     (form-map? form) (emit-quoted-map (form-map-pairs form))
     ;; plain jolt VALUES (metadata maps and anything nested in them)
     (map? form) (emit-quoted-map-value form)
     (vector? form) (str "(jolt-vector " (str/join " " (map emit-quoted form)) ")")
-    (set? form) (str "(jolt-hash-set " (str/join " " (map emit-quoted form)) ")")
+    (set? form) (str "(jolt-hash-set " (str/join " " (sort (map emit-quoted form))) ")")
     (seq? form) (str "(jolt-list " (str/join " " (map emit-quoted form)) ")")
     :else (throw (ex-info (str "emit-quoted: unsupported quoted form " (pr-str form)) {}))))
 

jolt-core/jolt/deps.clj

@@ -83,22 +83,26 @@
   declarations from every dep's deps.edn. `base-dir` resolves :local/root and is
   replaced by a dep's own root as the walk descends."
   [deps base-dir]
+  ;; queue grows by appending children at the tail; an index cursor walks it so
+  ;; each dequeue is O(1) (was (subvec (vec queue) 1) per pop -> O(n^2)).
   (loop [queue (mapv (fn [[c s]] [c s base-dir]) (seq deps))
+         i 0
          seen #{}
          roots []
          natives []]
-    (if (empty? queue)
+    (if (>= i (count queue))
       {:roots (distinct roots) :natives natives}
-      (let [[coord spec bd] (first queue)
-            queue (subvec (vec queue) 1)]
+      (let [[coord spec bd] (nth queue i)
+            i (inc i)]
         (if (contains? seen coord)
-          (recur queue seen roots natives)
+          (recur queue i seen roots natives)
           (let [root (coord-root coord spec bd)]
             (if (nil? root)
-              (recur queue (conj seen coord) roots natives)
+              (recur queue i (conj seen coord) roots natives)
               (let [edn (read-edn (str root "/deps.edn"))
                     child (mapv (fn [[c s]] [c s root]) (seq (:deps edn)))]
                 (recur (into queue child)
+                       i
                        (conj seen coord)
                        (into roots (dep-source-roots root))
                        (into natives (:jolt/native edn)))))))))))

jolt-core/jolt/ir.clj

@@ -20,9 +20,6 @@
 ;; end emits the embedded var cell so `binding`'s thread-binding frame can key on it.
 (defn the-var [ns name] {:op :the-var :ns ns :name name})
 
-;; A runtime primitive (cons, +, get, apply, …) the back end maps to the host RT.
-(defn rt [name] {:op :rt :name name})
-
 ;; A name that resolves only via the host's own environment (e.g. + or int?) —
 ;; the back end emits a host-appropriate reference.
 (defn host-ref [name] {:op :host :name name})
@@ -69,8 +66,6 @@
 (defn quote-node [form] {:op :quote :form form})
 (defn throw-node [expr] {:op :throw :expr expr})
 
-(defn op [node] (:op node))
-
 ;; ---------------------------------------------------------------------------
 ;; Structural recursion over IR child nodes.
 ;;
@@ -127,5 +122,39 @@
             n (if (get node :catch-body) (assoc n :catch-body (f (get node :catch-body))) n)
             n (if (get node :finally) (assoc n :finally (f (get node :finally))) n)]
         n)
-      ;; :const :local :var :host :host-static :the-var :rt :quote — no child nodes
+      ;; :const :local :var :host :host-static :the-var :quote — no child nodes
       :else node)))
+
+;; The read-only companion to map-ir-children: fold f over node's child IR nodes,
+;; left to right, threading acc — same single-sourced child layout, so a read-only
+;; analysis (size/closedness/purity) built on it is TOTAL over the op set (an
+;; unknown op, or a leaf, folds over no children and returns acc unchanged). Skips
+;; the same non-node positions map-ir-children does (binding NAMES, fn :params/
+;; :rest, :op/:ns/:name/:val). f is (acc child) -> acc.
+(defn reduce-ir-children [f acc node]
+  (let [op (get node :op)]
+    (cond
+      (= op :if) (f (f (f acc (get node :test)) (get node :then)) (get node :else))
+      (= op :do) (f (reduce f acc (get node :statements)) (get node :ret))
+      (= op :throw) (f acc (get node :expr))
+      (= op :set-var) (f acc (get node :val))
+      (= op :set-field) (f (f acc (get node :obj)) (get node :val))
+      (= op :defmacro) (f acc (get node :fn))
+      (= op :invoke) (reduce f (f acc (get node :fn)) (get node :args))
+      (= op :vector) (reduce f acc (get node :items))
+      (= op :set) (reduce f acc (get node :items))
+      (= op :map) (reduce (fn [a pr] (f (f a (nth pr 0)) (nth pr 1))) acc (get node :pairs))
+      (= op :let) (f (reduce (fn [a b] (f a (nth b 1))) acc (get node :bindings)) (get node :body))
+      (= op :loop) (f (reduce (fn [a b] (f a (nth b 1))) acc (get node :bindings)) (get node :body))
+      (= op :recur) (reduce f acc (get node :args))
+      (= op :fn) (reduce (fn [a ar] (f a (get ar :body))) acc (get node :arities))
+      (= op :def) (if (get node :init) (f acc (get node :init)) acc)
+      (= op :host-call) (reduce f (f acc (get node :target)) (get node :args))
+      (= op :host-new) (reduce f acc (get node :args))
+      (= op :try)
+      (let [a (f acc (get node :body))
+            a (if (get node :catch-body) (f a (get node :catch-body)) a)
+            a (if (get node :finally) (f a (get node :finally)) a)]
+        a)
+      ;; leaves and any op with no child nodes
+      :else acc)))

jolt-core/jolt/passes.clj

@@ -23,6 +23,10 @@
                                        reset-escapes! collected-escapes
                                        set-check-mode! take-diags!]]))
 
+;; Cap on inline -> flatten -> scalar-replace -> const-fold iterations. Each pass
+;; sets `dirty` when it rewrote something; the loop stops at a clean pass or here.
+(def ^:private inline-fixpoint-cap 8)
+
 (defn run-passes
   "All passes, in order. The back end applies this to every analyzed form. When
   inlining is enabled for the unit (user code under direct-linking),
@@ -41,7 +45,7 @@
           opt (loop [i 0 n (const-fold node)]
                 (reset! dirty false)
                 (let [n2 (const-fold (scalar-replace (flatten-lets (inline-node n ctx))))]
-                  (if (and @dirty (< i 8))
+                  (if (and @dirty (< i inline-fixpoint-cap))
                     (recur (inc i) n2)
                     n2)))]
       ;; a final const-fold after inference propagates any predicate folded to a

jolt-core/jolt/passes/fold.clj

@@ -46,7 +46,9 @@
             folded (when (and ff (pos? (count args)) (every? const-num? args))
                      (try
                        {:op :const :val (apply ff (mapv (fn [a] (get a :val)) args))}
-                       (catch Exception e nil)))]
+                       ;; :default (not Exception) — match the rest of jolt-core and
+                       ;; also catch a raw host condition from a folding primitive.
+                       (catch :default e nil)))]
         (or folded n))
 
       (= op :if)

jolt-core/jolt/passes/inline.clj

@@ -4,7 +4,7 @@
   share the alpha-rename invariant (every spliced binder is made globally fresh)
   and the `dirty` fixpoint flag. Portable Clojure (compiler-tier)."
   (:require [jolt.host :refer [inline-ir]]
-            [jolt.ir :refer [map-ir-children]]
+            [jolt.ir :refer [map-ir-children reduce-ir-children]]
             [jolt.passes.fold :refer [scalar-const?]]))
 
 ;; ---------------------------------------------------------------------------
@@ -54,27 +54,12 @@
 (defn- body-size
   "Node count of an inline-eligible body. A disallowed op contributes a number
   larger than any budget, so the caller's (<= size budget) test fails and we
-  never try to inline (or alpha-rename) such a body."
+  never try to inline (or alpha-rename) such a body. Only reached for safe ops,
+  so the shared child fold covers it exactly (leaves fold to 1)."
   [node]
-  (let [op (get node :op)]
-    (cond
-      (not (safe-op? op)) 100000
-      (= op :if) (+ 1 (body-size (get node :test))
-                      (body-size (get node :then))
-                      (body-size (get node :else)))
-      (= op :do) (+ 1 (reduce + 0 (mapv body-size (get node :statements)))
-                      (body-size (get node :ret)))
-      (= op :throw) (+ 1 (body-size (get node :expr)))
-      (= op :invoke) (+ 1 (body-size (get node :fn))
-                          (reduce + 0 (mapv body-size (get node :args))))
-      (= op :let) (+ 1 (reduce + 0 (mapv (fn [b] (body-size (nth b 1))) (get node :bindings)))
-                       (body-size (get node :body)))
-      (= op :vector) (+ 1 (reduce + 0 (mapv body-size (get node :items))))
-      (= op :set) (+ 1 (reduce + 0 (mapv body-size (get node :items))))
-      (= op :map) (+ 1 (reduce + 0 (mapv (fn [pr] (+ (body-size (nth pr 0))
-                                                     (body-size (nth pr 1))))
-                                         (get node :pairs))))
-      :else 1)))
+  (if (not (safe-op? (get node :op)))
+    100000
+    (reduce-ir-children (fn [acc c] (+ acc (body-size c))) 1 node)))
 
 (defn- subst
   "Substitute locals in node per env (a map name -> replacement IR node), and
@@ -129,24 +114,8 @@
   (let [op (get node :op)]
     (cond
       (= op :local) (contains? scope (get node :name))
-      (= op :const) true
-      (= op :var) true
-      (= op :host) true
-      (= op :the-var) true
-      (= op :quote) true
-      (= op :if) (and (body-closed? (get node :test) scope)
-                      (body-closed? (get node :then) scope)
-                      (body-closed? (get node :else) scope))
-      (= op :do) (and (every? (fn [s] (body-closed? s scope)) (get node :statements))
-                      (body-closed? (get node :ret) scope))
-      (= op :throw) (body-closed? (get node :expr) scope)
-      (= op :invoke) (and (body-closed? (get node :fn) scope)
-                          (every? (fn [a] (body-closed? a scope)) (get node :args)))
-      (= op :vector) (every? (fn [x] (body-closed? x scope)) (get node :items))
-      (= op :set) (every? (fn [x] (body-closed? x scope)) (get node :items))
-      (= op :map) (every? (fn [pr] (and (body-closed? (nth pr 0) scope)
-                                        (body-closed? (nth pr 1) scope)))
-                          (get node :pairs))
+      ;; :let threads scope sequentially (each binding extends it), so it can't go
+      ;; through the uniform fold.
       (= op :let)
       (let [res (reduce (fn [acc b]
                           (let [sc (nth acc 0) ok (nth acc 1)]
@@ -156,6 +125,9 @@
                         [scope true]
                         (get node :bindings))]
         (and (nth res 1) (body-closed? (get node :body) (nth res 0))))
+      ;; leaves (:const/:var/:host/:the-var/:quote) fold to true; the rest AND
+      ;; their children. Unsafe ops never reach here (body-size rejects them).
+      (safe-op? op) (reduce-ir-children (fn [ok c] (and ok (body-closed? c scope))) true node)
       :else false)))
 
 (defn- try-inline
@@ -267,20 +239,13 @@
   [node]
   (let [op (get node :op)]
     (cond
-      (= op :const) true
-      (= op :local) true
-      (= op :var) true
-      (= op :host) true
-      (= op :the-var) true
-      (= op :quote) true
-      (= op :if) (and (pure? (get node :test)) (pure? (get node :then)) (pure? (get node :else)))
-      (= op :do) (and (every? pure? (get node :statements)) (pure? (get node :ret)))
-      (= op :let) (and (every? (fn [b] (pure? (nth b 1))) (get node :bindings)) (pure? (get node :body)))
-      (= op :vector) (every? pure? (get node :items))
-      (= op :set) (every? pure? (get node :items))
-      (= op :map) (every? (fn [pr] (and (pure? (nth pr 0)) (pure? (nth pr 1)))) (get node :pairs))
+      ;; :invoke is pure only for a known-pure fn / record ctor, and only its ARGS
+      ;; are folded (not the :fn position) — so it can't go through the uniform fold.
       (= op :invoke) (and (or (pure-fn? (get node :fn)) (ctor-shape node))
                           (every? pure? (get node :args)))
+      ;; leaves (:const/:local/:var/:host/:the-var/:quote) fold to true; :if/:do/
+      ;; :let/:vector/:set/:map AND their children's purity.
+      (safe-op? op) (reduce-ir-children (fn [ok c] (and ok (pure? c))) true node)
       :else false)))
 
 (defn- const-key-map? [node]
@@ -340,7 +305,12 @@
   "Does local nm escape in node — i.e. is it used anywhere other than as the
   subject of a constant-keyword lookup? Precise over straight-line expression
   ops; conservatively true for loop/fn/try/recur/def (and any rebinding of nm),
-  so scalar replacement only fires where the whole use region is simple."
+  so scalar replacement only fires where the whole use region is simple.
+
+  Stays an explicit per-op walk (not the shared reduce-ir-children fold): its
+  default is conservatively TRUE, and the lookup-subject and rebinding cases
+  inspect node shape beyond child purity — folding an unhandled op over its
+  children would under-report escape and is unsound for scalar replacement."
   [node nm]
   (let [op (get node :op)
         k (lookup-key node nm)]

jolt-core/jolt/passes/types.clj

@@ -5,223 +5,78 @@
   checker. Also the inter-procedural driver API the back end calls to
   propagate param types across a unit / the whole program. Weakly coupled to the
   IR-rewriting passes — shares only the const-shape predicate (jolt.passes.fold)."
-  (:require [jolt.passes.fold :refer [scalar-const?]]))
+  (:require [jolt.passes.fold :refer [scalar-const?]]
+            [jolt.passes.types.lattice :refer
+             [velem selem sfields vec-type? set-type? struct-type? mk-vec mk-set
+              mk-struct union-cap scalar-t? union-type? umembers union-of merge-fields
+              join-t join type-depth cap struct-safe? field-type shape-order type-shape
+              mark-struct truthy-type? num-ret-fns vector-ret-fns]]))
 
-;; ---------------------------------------------------------------------------
-;; Collection-type inference, intra-procedural. A forward,
-;; soft-typing-style pass (simplified HM: monovariant, never-fails, lattice top
-;; = :any) that types expressions from literals/arithmetic and flows the type
-;; through let bindings and if-joins. Where a keyword-lookup subject is PROVEN a
-;; plain struct map it sets :hint :struct (the same channel a manual hint uses,
-;; so the back end drops the guard); where the type is :any it leaves the
-;; dynamic guard in place. Sound by construction: a concrete type is assigned
-;; only when proven, so a wrong bare get is impossible.
+;; --- engine state ------------------------------------------------------------
+;; The walk threads an immutable `env` (mk-env) instead of reading scattered
+;; module atoms: it carries the read-only config (rtenv/vtypes/record-shapes/
+;; protocol-methods/map-shapes?) plus the per-run flags (checking?/strict?) and
+;; per-run accumulator/guard CELLS (diags/calls/checking-set/diag-memo). A fresh
+;; env per run makes the pass re-entrant — a nested probe (isolated-diag-count)
+;; runs under a sub-env with its own diags cell, no save/restore.
 ;;
-;; Recursive STRUCTURAL types (RFC 0005). A type mirrors the data tree:
-;;   compound: {:struct {field -> T}}  (raw-get-safe map, field types)
-;;             {:vec T}                (vector of T)
-;;             {:set T}                (set of T)
-;;   scalar:   :num :str :kw :truthy   (all provably non-nil/non-false)
-;;             :phm                    (persistent hash map; NOT raw-get-safe)
-;;   :any (top), nil (bottom, identity for join).
-;; Compound types are small jolt maps, so they compare by value on both the
-;; Clojure and the host (orchestrator) side. struct/vec/set use distinct keys so
-;; a type is recognised by which key it carries.
-;; (get t :KEY) is nil for a keyword type and the child for a compound, so a
-;; compound is detected by some? — no map?/contains? needed.
-(defn- velem [t] (get t :vec))
-(defn- selem [t] (get t :set))
-(defn- sfields [t] (get t :struct))
-(defn- vec-type? [t] (some? (velem t)))
-(defn- set-type? [t] (some? (selem t)))
-(defn- struct-type? [t] (some? (sfields t)))
-(defn- mk-vec [t] {:vec (if t t :any)})
-(defn- mk-set [t] {:set (if t t :any)})
-(defn- mk-struct [fs] {:struct fs})
+;; Only state whose lifecycle spans separate API calls stays module-level: the
+;; config the orchestrator installs (set-*! before a sweep), the escapes and
+;; user-sig registries (collected/registered across the forms of a sweep), and a
+;; bridge holding the last checking run's diagnostics for take-diags!.
+(def ^:private config-box
+  (atom {:rtenv {}              ;; "ns/name" -> inferred return type
+         :vtypes {}             ;; "ns/name" -> var VALUE type (fn=:truthy, def=init type)
+         :record-shapes {}      ;; "ns/->Name" -> {:fields :tags :type}
+         :protocol-methods {}   ;; "ns/method" -> [proto method]
+         :map-shapes? false}))  ;; shape generic const-key maps (opt-in, JOLT_SHAPE)
+;; var-keys used as a VALUE (not a call head) — accumulated across a whole sweep,
+;; reset by reset-escapes! and read by collected-escapes.
+(def ^:private escapes-box (atom #{}))
+;; User-function error domains, opt-in. As the checker walks defs it registers
+;; each non-redefinable single-fixed-arity user fn's {:params :body} here, keyed
+;; "ns/name"; a later call site (strict mode) re-checks the body with one param
+;; bound to its concrete argument type. Accumulates ACROSS forms — a def must
+;; precede its call (the closed-world ordering RFC 0005 assumes).
+(def ^:private user-sig-box (atom {}))    ;; "ns/name" -> {:params [..] :body ir}
+;; Diagnostics from the last checking run-inference, for take-diags! to drain.
+(def ^:private last-diags-box (atom []))
+;; Whether run-inference also checks, and strictly. Set by set-check-mode!.
+(def ^:private check-mode-box (atom {:on false :strict false}))
 
-;; Bounded union types (RFC 0006). A union {:union #{T...}} records
-;; that a value is provably one of a small, fixed set of SCALAR types — what
-;; differing if-branches used to collapse to :any. It exists so the success
-;; checker can reject a use where EVERY member is in the op's error domain
-;; ((inc (if c "a" :k))) while still accepting one where any member is valid
-;; ((inc (if c 1 "x"))). Scalars only, capped cardinality: the member space is
-;; the five scalar tags, so the lattice stays finite and the inter-procedural
-;; fixpoint terminates. A union is opaque to every STRUCTURAL predicate
-;; (struct-type?/vec-type?/set-type? key on :struct/:vec/:set, which a union
-;; lacks), so specialization treats it exactly like :any — codegen is
-;; unchanged; only the checker reads inside it.
-(def ^:private union-cap 4)
-(defn- scalar-t? [t] (or (= t :num) (= t :str) (= t :kw) (= t :truthy) (= t :phm)))
-(defn- union-type? [t] (some? (get t :union)))
-(defn- umembers [t] (get t :union))
-(defn- union-of
-  "Normalize a seq of member types into a lattice value: flatten nested unions,
-  keep only scalars (any non-scalar member collapses the whole thing to :any,
-  the conservative top), then return the lone member if one, {:union #{...}}
-  for 2..cap distinct scalars, or :any past the cap."
-  [ts]
-  (let [flat (reduce (fn [acc t]
-                       (if (union-type? t)
-                         (reduce conj acc (umembers t))
-                         (conj acc t)))
-                     #{} ts)]
-    (cond
-      (not (every? scalar-t? flat)) :any
-      (= 0 (count flat)) :any
-      (= 1 (count flat)) (first flat)
-      (> (count flat) union-cap) :any
-      :else {:union flat})))
+;; build a per-run env: a snapshot of the installed config plus this run's flags
+;; and fresh accumulator/guard cells. escapes/user-sigs reference the sweep-level
+;; module cells (their lifecycle spans calls); diags/calls/checking-set/diag-memo
+;; are this run's own.
+(defn- mk-env [checking? strict?]
+  (let [c @config-box]
+    {:rtenv (get c :rtenv) :vtypes (get c :vtypes)
+     :record-shapes (get c :record-shapes) :protocol-methods (get c :protocol-methods)
+     :map-shapes? (get c :map-shapes?)
+     :checking? checking? :strict? strict?
+     :diags (atom []) :calls (atom []) :checking-set (atom #{}) :diag-memo (atom {})
+     :escapes escapes-box :user-sigs user-sig-box}))
 
-(declare join-t)
-(defn- merge-fields
-  "Per-field join of two field maps (a key in only one side joins with :any)."
-  [fa fb]
-  (let [m1 (reduce (fn [m k] (assoc m k (join-t (get fa k :any) (get fb k :any)))) {} (keys fa))]
-    (reduce (fn [m k] (if (get m k) m (assoc m k (join-t (get fa k :any) (get fb k :any))))) m1 (keys fb))))
-(defn- join-t [a b]
-  (cond
-    (= a b) a
-    (nil? a) b
-    (nil? b) a
-    (and (struct-type? a) (struct-type? b))
-      (let [merged (mk-struct (merge-fields (sfields a) (sfields b)))]
-        ;; joining two values of the SAME complete shape preserves it — the
-        ;; merged struct has the same key set. Different shapes
-        ;; (or an incomplete side) drop it, as the layout is no longer proven.
-        (if (and (get a :shape) (= (get a :shape) (get b :shape)))
-          (assoc merged :shape (get a :shape))
-          merged))
-    (and (vec-type? a) (vec-type? b)) (mk-vec (join-t (velem a) (velem b)))
-    (and (set-type? a) (set-type? b)) (mk-set (join-t (selem a) (selem b)))
-    ;; differing kinds: form a scalar union when both sides reduce to scalars
-    ;; (or scalar unions); anything compound on either side stays :any
-    :else (let [ma (cond (union-type? a) (umembers a) (scalar-t? a) #{a} :else nil)
-                mb (cond (union-type? b) (umembers b) (scalar-t? b) #{b} :else nil)]
-            (if (and ma mb) (union-of (reduce conj ma mb)) :any))))
-(defn- join [a b] (join-t a b))
-;; depth cap (RFC 0005): truncate a type below depth d to :any, so recursive data
-;; can't make an infinite type and the inter-procedural fixpoint stays finite.
-(def ^:private type-depth 4)
-(defn- cap [t d]
-  (cond
-    (<= d 0) (if (or (struct-type? t) (vec-type? t) (set-type? t)) :any t)
-    (struct-type? t)
-      ;; capping truncates VALUES below depth d, but the KEY SET is unchanged, so
-      ;; a complete :shape survives — keep it so nested/container field reads can
-      ;; still bare-index. cap recurses into fields, so a nested
-      ;; shaped value (a vec3 inside a hit-info) keeps its own :shape too.
-      (let [capped (mk-struct (reduce (fn [m k] (assoc m k (cap (get (sfields t) k) (dec d))))
-                                      {} (keys (sfields t))))
-            ;; the record :type tag (and :shape) are independent of field-value
-            ;; depth, so they survive truncation — a record read from a deep
-            ;; container keeps its identity, so devirtualization, record? folding,
-            ;; and the record fast path still fire on it.
-            capped (if (get t :shape) (assoc capped :shape (get t :shape)) capped)
-            capped (if (get t :type) (assoc capped :type (get t :type)) capped)]
-        capped)
-    (vec-type? t) (mk-vec (cap (velem t) (dec d)))
-    (set-type? t) (mk-set (cap (selem t) (dec d)))
-    :else t))
-;; raw-get-safe (a struct / record): a struct type. The field type of key
-;; k, if known, else :any.
-(defn- struct-safe? [t] (struct-type? t))
-(defn- field-type [t k] (if (struct-type? t) (get (sfields t) k :any) :any))
-;; Shape (hidden class). A struct type built from a map LITERAL carries
-;; its complete layout — :shape, the canonical (str-sorted) key vector. The back
-;; end represents such a map as a shape tuple and reads a field by bare index.
-;; A struct type from a JOIN or from field-access inference has no :shape
-;; (incomplete: the full key set isn't proven), so it keeps the dynamic path —
-;; never a bare index. No shape is hardcoded; any constant key set is one.
-(defn- shape-order
-  "Canonical key order for a shape: keys sorted by their string form, so two
-  literals with the same keys in any order intern to the same shape."
-  [ks] (vec (sort (fn [a b] (compare (str a) (str b))) ks)))
-(defn- type-shape [t] (get t :shape))
-;; tag a node (any expression, not just a :local) so the back end can specialize
-;; a lookup whose SUBJECT is that node — this is what makes nested access work:
-;; (:direction ray) is tagged struct, so (:r (:direction ray)) drops its guard.
-;; tag a lookup subject as a struct, carrying the complete shape when known
-;; (so the back end bare-indexes).
-(defn- mark-struct [node t]
-  (let [n (assoc node :hint :struct)]
-    (if (get t :shape) (assoc n :shape (get t :shape)) n)))
-;; a value provably neither nil nor false — the back end only builds a struct
-;; (vs a phm) when every value is non-nil/non-false, so a map literal is a struct
-;; only when all its values have such a type. Collections are non-nil.
-(defn- truthy-type? [t]
-  (or (= t :num) (= t :str) (= t :kw) (= t :truthy) (= t :phm)
-      (struct-type? t) (vec-type? t) (set-type? t)))
-
-;; core fns whose result is a number (so it is non-nil/non-false and, for the
-;; success-type checker, provably numeric).
-(def ^:private num-ret-fns
-  #{"+" "-" "*" "/" "inc" "dec" "mod" "rem" "quot" "min" "max" "abs"
-    "bit-and" "bit-or" "bit-xor" "count"})
-(def ^:private vector-ret-fns #{"vec" "vector" "mapv" "filterv" "subvec"})
-
-;; Inter-procedural state. The orchestrator (backend
-;; infer-unit!) drives a whole-unit fixpoint: before typing a fn body it installs
-;; the current return-type estimates of all unit fns here, and after typing it
-;; reads back the call sites this body made (callee + inferred arg types) to
-;; propagate into callee param types. Both are plain module state, like `dirty`.
-(def ^:private rtenv-box (atom {}))   ;; "ns/name" -> inferred return type
-(def ^:private calls-box (atom []))   ;; collected [ "ns/name" [arg-types...] ]
-(def ^:private escapes-box (atom #{})) ;; var-keys used as a VALUE (not a call head)
-(def ^:private diag-box (atom []))    ;; success-type-check diagnostics (RFC 0006)
-;; a var reference's VALUE type — a fn var is :truthy (non-nil), a def
-;; var carries its inferred init type (e.g. a color table -> {:vec :struct-map}).
-;; The orchestrator populates this from sealed (opt-mode) cell roots + def inits.
-(def ^:private vtype-box (atom {}))   ;; "ns/name" -> value type
-
-;; User-function error domains, opt-in. As the checker walks defs it
-;; registers each non-redefinable single-fixed-arity user fn's {:params :body}
-;; here, keyed "ns/name". At a later call site (strict mode only) the body is
-;; re-checked with ONE parameter bound to its concrete argument type — if that
-;; alone produces a diagnostic the all-:any body did not, that argument is
-;; provably wrong and the CALL is reported. Module state, like rtenv-box: a def
-;; must precede its call (the same closed-world ordering RFC 0005 assumes).
-(def ^:private user-sig-box (atom {}))      ;; "ns/name" -> {:params [..] :body ir}
-;; a record constructor's return shape. "ns/->Name" -> [field-kw ...]
-;; in DECLARED order (the runtime lays records out in declared field order, so
-;; the back end bare-indexes by that order). A call (->Point a b) types as a
-;; struct of this shape, so field reads on the result bare-index — declared
-;; shapes are clean fuel: a lookup, not fragile inference.
-(def ^:private record-shapes-box (atom {}))
-;; protocol-method registry "ns/method" -> [proto method], for
-;; devirtualizing a protocol call whose receiver is a known record type.
-(def ^:private protocol-methods-box (atom {}))
-
-;; build a record's struct TYPE from its registry entry, resolving each
-;; field's declared type hint. A field tagged with a record type (its ctor-key)
-;; recurses, so a Vec3 stored in a Ray field reads back as Vec3 — not :any —
-;; which is what lets nested-record code prove its reads. Depth-bounded so a
-;; self/cyclic-referencing record type can't loop.
+;; build a record's struct TYPE from its registry entry, resolving each field's
+;; declared type hint against `shapes` ("ns/->Name" -> entry). A field tagged with
+;; a record type (its ctor-key) recurses, so a Vec3 stored in a Ray field reads
+;; back as Vec3 — not :any — which is what lets nested-record code prove its reads.
+;; Depth-bounded so a self/cyclic-referencing record type can't loop.
 (declare record-type-from-entry)
-(defn- field-type-from-tag [tag depth]
+(defn- field-type-from-tag [tag depth shapes]
   (cond
     (or (nil? tag) (<= depth 0)) :any
     (= tag "num") :num
-    :else (let [e (get @record-shapes-box tag)]
-            (if e (record-type-from-entry e depth) :any))))
-(defn- record-type-from-entry [rs depth]
+    :else (let [e (get shapes tag)]
+            (if e (record-type-from-entry e depth shapes) :any))))
+(defn- record-type-from-entry [rs depth shapes]
   (let [fields (get rs :fields)
         tags (get rs :tags)
         fmap (reduce (fn [m i]
                        (assoc m (nth fields i)
-                              (field-type-from-tag (when tags (nth tags i)) (dec depth))))
+                              (field-type-from-tag (when tags (nth tags i)) (dec depth) shapes)))
                      {} (range (count fields)))]
     (assoc (mk-struct fmap) :shape (vec fields) :type (get rs :type))))
-;; whether to shape generic const-key MAP literals (opt-in, JOLT_SHAPE).
-;; Records are shaped regardless; maps only when this is on.
-(def ^:private map-shapes-box (atom false))
-(def ^:private checking-box (atom #{}))     ;; keys mid-recheck — cycle guard
-(def ^:private strict-box (atom false))     ;; report against user-fn domains?
-;; When true, `infer` emits success-type diagnostics as it types (jolt audit).
-;; The checker IS the inference walk now — one O(n) pass that both types and
-;; checks, instead of a separate check-walk that re-inferred every subtree
-;; (quadratic in nesting). Off during the optimization fixpoint so it doesn't
-;; emit intermediate diagnostics; on only inside check-form.
-(def ^:private checking? (atom false))
 
 ;; fns that RETURN an element of their (first) collection arg, so a lookup on the
 ;; result of (rand-nth coll-of-structs) etc. types as the element.
@@ -232,18 +87,19 @@
 
 (defn- var-key [fnode] (str (get fnode :ns) "/" (get fnode :name)))
 
-(defn- call-ret-type [fnode]
-  (let [op (get fnode :op)]
+(defn- call-ret-type [fnode env]
+  (let [op (get fnode :op)
+        shapes (get env :record-shapes)]
     (cond
       ;; a user fn whose return type the fixpoint has estimated
-      (= op :var) (let [rs (get @record-shapes-box (var-key fnode))]
+      (= op :var) (let [rs (get shapes (var-key fnode))]
                     (if rs
                       ;; record ctor -> struct of declared shape; :shape
                       ;; is the DECLARED field order the back end indexes by, :type
                       ;; the record tag (devirt), and field types come from the
                       ;; declared hints so nested records stay typed
-                      (record-type-from-entry rs type-depth)
-                      (let [r (get @rtenv-box (var-key fnode))]
+                      (record-type-from-entry rs type-depth shapes)
+                      (let [r (get (get env :rtenv) (var-key fnode))]
                         (if r r (let [nm (and (= "clojure.core" (get fnode :ns)) (get fnode :name))]
                                   (cond (nil? nm) :any
                                         (contains? num-ret-fns nm) :num
@@ -302,7 +158,7 @@
   types (seeds: param-index -> type), other params :any, captured locals from
   tenv. Returns [ret-type node'] — ret is the lub of arity tail types, used to
   type the HOF result (e.g. reduce's accumulator, mapv's element)."
-  [node seeds tenv]
+  [node seeds tenv env]
   (let [res (mapv (fn [a]
                     (let [params (get a :params)
                           pe (reduce (fn [e i]
@@ -310,7 +166,7 @@
                                               (let [s (get seeds i)] (if s s :any))))
                                      tenv (range (count params)))
                           pe (if (get a :rest) (assoc pe (get a :rest) :any) pe)
-                          br (infer (get a :body) pe)]
+                          br (infer (get a :body) pe env)]
                       [(nth br 0) (assoc a :body (nth br 1))]))
                   (get node :arities))
         rets (mapv (fn [r] (nth r 0)) res)
@@ -320,8 +176,8 @@
 (defn- infer
   "Returns [type node'] — the inferred type of node and node with struct-safe
   :local references annotated :hint :struct. tenv maps in-scope local names to
-  inferred types."
-  [node tenv]
+  inferred types; env carries the inference config and this run's accumulators."
+  [node tenv env]
   (let [op (get node :op)]
     (cond
       (= op :const)
@@ -343,8 +199,8 @@
       (= op :map)
       (let [pairs (get node :pairs)
             res (mapv (fn [pr]
-                        (let [kr (infer (nth pr 0) tenv)
-                              vr (infer (nth pr 1) tenv)]
+                        (let [kr (infer (nth pr 0) tenv env)
+                              vr (infer (nth pr 1) tenv env)]
                           [(nth kr 1) (nth vr 1) (nth vr 0) (get (nth pr 0) :val)]))
                       pairs)
             struct? (and (> (count res) 0)
@@ -354,38 +210,38 @@
                    (cap (mk-struct (reduce (fn [m r] (assoc m (nth r 3) (nth r 2))) {} res)) type-depth))
             ;; a literal is a COMPLETE shape: carry its sorted key vector so the
             ;; back end can lay it out and bare-index lookups
-            shp (when (and @map-shapes-box base (struct-type? base)) (shape-order (keys (sfields base))))
+            shp (when (and (get env :map-shapes?) base (struct-type? base)) (shape-order (keys (sfields base))))
             t (if base (if shp (assoc base :shape shp) base) :any)
             node' (assoc node :pairs (mapv (fn [r] [(nth r 0) (nth r 1)]) res))]
         [t (if shp (assoc node' :shape shp) node')])
       (= op :vector)
-      (let [irs (mapv (fn [x] (infer x tenv)) (get node :items))
+      (let [irs (mapv (fn [x] (infer x tenv env)) (get node :items))
             ets (mapv (fn [r] (nth r 0)) irs)
             el (if (empty? ets) :any (reduce join (first ets) (rest ets)))]
         [(cap (mk-vec el) type-depth) (assoc node :items (mapv (fn [r] (nth r 1)) irs))])
       (= op :set)
-      (let [irs (mapv (fn [x] (infer x tenv)) (get node :items))
+      (let [irs (mapv (fn [x] (infer x tenv env)) (get node :items))
             ets (mapv (fn [r] (nth r 0)) irs)
             el (if (empty? ets) :any (reduce join (first ets) (rest ets)))]
         [(cap (mk-set el) type-depth) (assoc node :items (mapv (fn [r] (nth r 1)) irs))])
       (= op :if)
-      (let [tr (infer (get node :test) tenv)
-            thn (infer (get node :then) tenv)
-            els (infer (get node :else) tenv)]
+      (let [tr (infer (get node :test) tenv env)
+            thn (infer (get node :then) tenv env)
+            els (infer (get node :else) tenv env)]
         [(join (nth thn 0) (nth els 0))
          (assoc node :test (nth tr 1) :then (nth thn 1) :else (nth els 1))])
       (= op :do)
-      (let [stmts (mapv (fn [s] (nth (infer s tenv) 1)) (get node :statements))
-            r (infer (get node :ret) tenv)]
+      (let [stmts (mapv (fn [s] (nth (infer s tenv env) 1)) (get node :statements))
+            r (infer (get node :ret) tenv env)]
         [(nth r 0) (assoc node :statements stmts :ret (nth r 1))])
       (= op :throw)
-      [:any (assoc node :expr (nth (infer (get node :expr) tenv) 1))]
+      [:any (assoc node :expr (nth (infer (get node :expr) tenv env) 1))]
       ;; a :var reached HERE is in value position (an arg, a let init, ...), not
       ;; a call head — so the fn it names escapes and its params can't be inferred.
-      ;; Its VALUE type comes from vtype-box (a fn is :truthy, a def carries its
+      ;; Its VALUE type comes from vtypes (a fn is :truthy, a def carries its
       ;; inferred type); unknown -> :any.
-      (= op :var) (do (swap! escapes-box conj (var-key node))
-                      [(let [vt (get @vtype-box (var-key node))] (if vt vt :any)) node])
+      (= op :var) (do (swap! (get env :escapes) conj (var-key node))
+                      [(let [vt (get (get env :vtypes) (var-key node))] (if vt vt :any)) node])
       (= op :invoke)
       (let [fnode (get node :fn)
             iscall-var (= :var (get fnode :op))
@@ -399,32 +255,32 @@
           ;; after inference) collapsing any `if` it gates. Falls through to the
           ;; normal call path when the answer isn't provable or the arg is impure.
           (and iscall-var (contains? fold-preds cn) (= n 1))
-          (let [ar (infer (nth args 0) tenv)
+          (let [ar (infer (nth args 0) tenv env)
                 v (pred-on cn (nth ar 0))]
             (if (and (not (nil? v)) (pure-node? (nth ar 1)))
               [:any {:op :const :val v}]
-              [(call-ret-type fnode) (assoc node :args [(nth ar 1)])]))
+              [(call-ret-type fnode env) (assoc node :args [(nth ar 1)])]))
           ;; (:k m) / (:k m default): the result is m's field type, and if m is a
           ;; struct the subject is tagged so the back end drops the guard — this
           ;; types nested access end to end (RFC 0005).
           (and (= :const (get fnode :op)) (keyword? (get fnode :val)) (>= n 1) (<= n 2))
-          (let [mr (infer (nth args 0) tenv)
+          (let [mr (infer (nth args 0) tenv env)
                 mt (nth mr 0)
                 msub (if (struct-safe? mt) (mark-struct (nth mr 1) mt) (nth mr 1))
                 ft (field-type mt (get fnode :val))
-                dr (when (= n 2) (infer (nth args 1) tenv))]
+                dr (when (= n 2) (infer (nth args 1) tenv env))]
             [(if dr (join ft (nth dr 0)) ft)
              (assoc node :args (if dr [msub (nth dr 1)] [msub]))])
           ;; (get m :k [default]): same, when the key is a constant keyword.
           (and (or (and (= :var (get fnode :op)) (= "clojure.core" (get fnode :ns)) (= "get" (get fnode :name)))
                    (and (= :host (get fnode :op)) (= "get" (get fnode :name))))
                (>= n 2) (= :const (get (nth args 1) :op)) (keyword? (get (nth args 1) :val)))
-          (let [mr (infer (nth args 0) tenv)
+          (let [mr (infer (nth args 0) tenv env)
                 mt (nth mr 0)
                 msub (if (struct-safe? mt) (mark-struct (nth mr 1) mt) (nth mr 1))
-                kr (infer (nth args 1) tenv)
+                kr (infer (nth args 1) tenv env)
                 ft (field-type mt (get (nth args 1) :val))
-                dr (when (= n 3) (infer (nth args 2) tenv))]
+                dr (when (= n 3) (infer (nth args 2) tenv env))]
             [(if dr (join ft (nth dr 0)) ft)
              (assoc node :args (if dr [msub (nth kr 1) (nth dr 1)] [msub (nth kr 1)]))])
           ;; reduce over a typed vector with a fn-literal: seed the
@@ -433,11 +289,11 @@
           ;; it makes — see those types.
           (and (= cn "reduce") (>= n 2) (= :fn (get (nth args 0) :op)))
           (let [three (>= n 3)
-                coll-r (infer (nth args (if three 2 1)) tenv)
-                init-r (when three (infer (nth args 1) tenv))
+                coll-r (infer (nth args (if three 2 1)) tenv env)
+                init-r (when three (infer (nth args 1) tenv env))
                 et (let [ct (nth coll-r 0)] (if (vec-type? ct) (velem ct) :any))
                 init-t (if init-r (nth init-r 0) :any)
-                fn-r (infer-fn-seeded (nth args 0) {0 init-t 1 et} tenv)]
+                fn-r (infer-fn-seeded (nth args 0) {0 init-t 1 et} tenv env)]
             [(join init-t (nth fn-r 0))
              (assoc node :args (if three
                                  [(nth fn-r 1) (nth init-r 1) (nth coll-r 1)]
@@ -445,16 +301,16 @@
           ;; map/mapv/filter/... over a typed vector with a fn-literal: seed the
           ;; fn's element param; mapv/filterv produce a typed vector.
           (and cn (get hof-table cn) (>= n 2) (= :fn (get (nth args 0) :op)))
-          (let [coll-r (infer (nth args 1) tenv)
+          (let [coll-r (infer (nth args 1) tenv env)
                 et (let [ct (nth coll-r 0)] (if (vec-type? ct) (velem ct) :any))
-                fn-r (infer-fn-seeded (nth args 0) {(get (get hof-table cn) :epos) et} tenv)
+                fn-r (infer-fn-seeded (nth args 0) {(get (get hof-table cn) :epos) et} tenv env)
                 rt (cond (= cn "mapv") (mk-vec (nth fn-r 0))
                          (= cn "filterv") (mk-vec et)
                          :else :any)]
             [rt (assoc node :args [(nth fn-r 1) (nth coll-r 1)])])
           ;; conj/into: track the element type of a vector being grown.
           (and (or (= cn "conj") (= cn "into")) (>= n 1))
-          (let [ares (mapv (fn [a] (infer a tenv)) args)
+          (let [ares (mapv (fn [a] (infer a tenv env)) args)
                 base (nth (nth ares 0) 0)
                 rest-ts (mapv (fn [r] (nth r 0)) (rest ares))
                 rt (cond
@@ -462,40 +318,40 @@
                      (mk-vec (reduce join (velem base) rest-ts))
                      (and (= cn "into") (vec-type? base) (= 2 n) (vec-type? (nth rest-ts 0)))
                      (mk-vec (join (velem base) (velem (nth rest-ts 0))))
-                     :else (call-ret-type fnode))]
+                     :else (call-ret-type fnode env))]
             [rt (assoc node :args (mapv (fn [r] (nth r 1)) ares))])
           ;; everything else: type args, collect the call (var callee), use the
           ;; declared/estimated return type. range produces a numeric vector.
           :else
-          (let [fr (when (not iscall-var) (infer fnode tenv))
+          (let [fr (when (not iscall-var) (infer fnode tenv env))
                 fnode' (if iscall-var fnode (nth fr 1))
-                ;; the callee's value type: a var's from vtype-box (a fn is
+                ;; the callee's value type: a var's from vtypes (a fn is
                 ;; :truthy, a def carries its inferred type), else the inferred
                 ;; type of the callee expression
-                callee-t (if iscall-var (get @vtype-box (var-key fnode)) (nth fr 0))
-                ares (mapv (fn [a] (infer a tenv)) args)]
+                callee-t (if iscall-var (get (get env :vtypes) (var-key fnode)) (nth fr 0))
+                ares (mapv (fn [a] (infer a tenv env)) args)]
             (when iscall-var
-              (swap! calls-box conj [(var-key fnode) (mapv (fn [r] (nth r 0)) ares)]))
+              (swap! (get env :calls) conj [(var-key fnode) (mapv (fn [r] (nth r 0)) ares)]))
             ;; success-type check at this call, reusing the arg types just
             ;; computed (jolt audit): core error domains always, user-fn domains
             ;; in strict mode. The arg subtrees are inferred exactly once.
-            (when @checking?
+            (when (get env :checking?)
               (let [ats (mapv (fn [r] (nth r 0)) ares) pos (get node :pos)]
-                (when cn (check-invoke cn args ats pos))
+                (when cn (check-invoke cn args ats pos env))
                 ;; calling a provably non-function
                 (when (not-callable? callee-t)
-                  (swap! diag-box conj
+                  (swap! (get env :diags) conj
                          {:op :call :type (type-name callee-t) :pos pos
                           :msg (str "cannot call " (type-name callee-t) " as a function")}))
-                (when (and @strict-box iscall-var)
-                  (let [k (var-key fnode) usig (get @user-sig-box k)]
-                    (when usig (check-user-call k usig ats pos))))))
+                (when (and (get env :strict?) iscall-var)
+                  (let [k (var-key fnode) usig (get @(get env :user-sigs) k)]
+                    (when usig (check-user-call k usig ats pos env))))))
             ;; devirtualization: a protocol-method call whose receiver
             ;; (arg 0) is a known record type resolves to a direct method call.
             ;; Annotate the node with [type-tag proto method]; the back end looks
             ;; up the impl at emit time and calls it directly, skipping the
             ;; registry dispatch (~19x cheaper than protocol-dispatch).
-            (let [pm (and iscall-var (get @protocol-methods-box (var-key fnode)))
+            (let [pm (and iscall-var (get (get env :protocol-methods) (var-key fnode)))
                   rtype (when (and pm (pos? n)) (get (nth (nth ares 0) 0) :type))
                   base (assoc node :fn fnode' :args (mapv (fn [r] (nth r 1)) ares))]
               [(cond
@@ -503,27 +359,27 @@
                  ;; element-returning fn over a typed vector -> the element type
                  (and cn (contains? elem-fns cn) (> n 0))
                  (let [a0 (nth (nth ares 0) 0)] (if (vec-type? a0) (velem a0) :any))
-                 :else (call-ret-type fnode))
+                 :else (call-ret-type fnode env))
                (if rtype
                  (assoc base :devirt-type rtype :devirt-proto (nth pm 0) :devirt-method (nth pm 1))
                  base)]))))
       (= op :let)
       (let [res (reduce (fn [acc b]
                           (let [te (nth acc 0) binds (nth acc 1)
-                                ir (infer (nth b 1) te)]
+                                ir (infer (nth b 1) te env)]
                             [(assoc te (nth b 0) (nth ir 0)) (conj binds [(nth b 0) (nth ir 1)])]))
                         [tenv []] (get node :bindings))
-            br (infer (get node :body) (nth res 0))]
+            br (infer (get node :body) (nth res 0) env)]
         [(nth br 0) (assoc node :bindings (nth res 1) :body (nth br 1))])
       (= op :loop)
       ;; conservative + sound: loop bindings join across recur, which we don't
       ;; track here, so they stay :any. Still descend to annotate any
       ;; known-type lookups inside the body.
       [:any (assoc node
-                   :bindings (mapv (fn [b] [(nth b 0) (nth (infer (nth b 1) tenv) 1)]) (get node :bindings))
-                   :body (nth (infer (get node :body) tenv) 1))]
+                   :bindings (mapv (fn [b] [(nth b 0) (nth (infer (nth b 1) tenv env) 1)]) (get node :bindings))
+                   :body (nth (infer (get node :body) tenv env) 1))]
       (= op :recur)
-      [:any (assoc node :args (mapv (fn [a] (nth (infer a tenv) 1)) (get node :args)))]
+      [:any (assoc node :args (mapv (fn [a] (nth (infer a tenv env) 1)) (get node :args)))]
       (= op :fn)
       ;; a closure inherits the enclosing tenv so CAPTURED locals keep their
       ;; types (e.g. a reduce closure that calls (f captured-struct ...)). Its own
@@ -534,27 +390,28 @@
       ;; read its fields without the runtime tag guard.
       [:any (assoc node :arities
                    (mapv (fn [a]
-                           (let [phm (reduce (fn [m pr] (assoc m (nth pr 0) (nth pr 1)))
+                           (let [shapes (get env :record-shapes)
+                                 phm (reduce (fn [m pr] (assoc m (nth pr 0) (nth pr 1)))
                                              {} (get a :phints))
                                  pe (reduce (fn [e p]
                                               (assoc e p
-                                                     (let [ent (get @record-shapes-box (get phm p))]
-                                                       (if ent (record-type-from-entry ent type-depth) :any))))
+                                                     (let [ent (get shapes (get phm p))]
+                                                       (if ent (record-type-from-entry ent type-depth shapes) :any))))
                                             tenv (get a :params))
                                  pe (if (get a :rest) (assoc pe (get a :rest) :any) pe)]
-                             (assoc a :body (nth (infer (get a :body) pe) 1))))
+                             (assoc a :body (nth (infer (get a :body) pe env) 1))))
                          (get node :arities)))]
       (= op :def)
-      (do (when @checking? (register-user-fn! node))
-          [:any (assoc node :init (nth (infer (get node :init) tenv) 1))])
+      (do (when (get env :checking?) (register-user-fn! node env))
+          [:any (assoc node :init (nth (infer (get node :init) tenv env) 1))])
       (= op :try)
       [:any (assoc node
-                   :body (nth (infer (get node :body) tenv) 1)
-                   :catch-body (when (get node :catch-body) (nth (infer (get node :catch-body) tenv) 1))
-                   :finally (when (get node :finally) (nth (infer (get node :finally) tenv) 1)))]
+                   :body (nth (infer (get node :body) tenv env) 1)
+                   :catch-body (when (get node :catch-body) (nth (infer (get node :catch-body) tenv env) 1))
+                   :finally (when (get node :finally) (nth (infer (get node :finally) tenv env) 1)))]
       :else [:any node])))
 
-(defn- infer-top [node] (nth (infer node {}) 1))
+(defn- infer-top [node env] (nth (infer node {} env) 1))
 
 ;; ---------------------------------------------------------------------------
 ;; Success-type checking (RFC 0006). Reuse the inference above as a loose type
@@ -614,15 +471,16 @@
 
 (defn- check-invoke
   "If node is a core-op call whose argument type is provably in the error domain,
-  conj a diagnostic. arg-types is the vector of inferred argument types; pos is
-  the call form's source offset, carried into each diagnostic."
-  [cn args arg-types pos]
+  conj a diagnostic into env's diags cell. arg-types is the vector of inferred
+  argument types; pos is the call form's source offset, carried into each
+  diagnostic."
+  [cn args arg-types pos env]
   (cond
     (contains? num-ops cn)
     (reduce (fn [_ i]
               (let [t (nth arg-types i)]
                 (when (not-number? t)
-                  (swap! diag-box conj
+                  (swap! (get env :diags) conj
                          {:op cn :argpos i :type (type-name t) :pos pos
                           :msg (str "`" cn "` requires a number, but argument "
                                     (inc i) " is " (type-name t))})))
@@ -631,7 +489,7 @@
     (and (contains? seq-ops cn) (> (count args) 0))
     (let [t (nth arg-types 0)]
       (when (not-seqable? t)
-        (swap! diag-box conj
+        (swap! (get env :diags) conj
                {:op cn :argpos 0 :type (type-name t) :pos pos
                 :msg (str "`" cn "` requires "
                           (if (= cn "count") "a countable collection" "a seqable")
@@ -645,22 +503,20 @@
   (reduce (fn [e p] (assoc e p :any)) {} params))
 
 (defn- isolated-diag-count
-  "Count of diagnostics typing body under tenv produces, with the shared
-  diag-box saved and restored so this probe never leaks into the real report.
-  Runs the same checking inference as check-form (checking? is already on)."
-  [body tenv]
-  (let [saved @diag-box]
-    (reset! diag-box [])
-    (infer body tenv)
-    (let [n (count @diag-box)]
-      (reset! diag-box saved)
-      n)))
+  "Count of diagnostics typing body under tenv produces. Runs under a SUB-ENV
+  with its own diags cell, so this probe never leaks into the real report (the
+  shared calls/escapes/guard cells are intentionally still threaded — they are
+  not read here). Runs the same checking inference as check-form."
+  [body tenv env]
+  (let [sub (assoc env :diags (atom []))]
+    (infer body tenv sub)
+    (count @(get sub :diags))))
 
 (defn- register-user-fn!
   "Record a (def name (fn [params] body)) — single fixed arity, not redefinable —
   for later user-fn call checking. Redefinable/dynamic and multi/variadic fns are
   skipped (their body is not a stable requirement)."
-  [node]
+  [node env]
   (let [init (get node :init)
         m (get node :meta)
         redefable (and m (or (get m :redef) (get m :dynamic)))]
@@ -669,7 +525,7 @@
         (when (= 1 (count arities))
           (let [ar (first arities)]
             (when (not (get ar :rest))
-              (swap! user-sig-box assoc
+              (swap! (get env :user-sigs) assoc
                      (str (get node :ns) "/" (get node :name))
                      {:name (get node :name)
                       :params (get ar :params) :body (get ar :body)}))))))))
@@ -682,55 +538,69 @@
   its arg type (others :any); a diagnostic the all-:any body did not already
   have means the argument alone is provably wrong. Monotonic — binding a
   concrete type can only ADD error-domain hits — so no false positive.
-  Cycle-guarded so mutually recursive fns terminate."
-  [key sig arg-types pos]
-  (when (not (contains? @checking-box key))
-    (let [prev @checking-box]
-      (reset! checking-box (conj prev key))
-      (let [params (:params sig)
-            body (:body sig)
-            npar (count params)
-            nargs (count arg-types)]
-        (if (not= npar nargs)
-          ;; arity is provably wrong regardless of types — report and stop (the
-          ;; per-arg type re-check would bind params positionally, meaningless
-          ;; under a mismatch)
-          (swap! diag-box conj
-                 {:op :user-call :type :arity :pos pos
-                  :msg (str "wrong number of args (" nargs ") passed to `"
-                            (:name sig) "` (expected " npar ")")})
-          (let [base (isolated-diag-count body (all-any-env params))]
-            (reduce
-              (fn [_ i]
-                (let [at (nth arg-types i)]
-                  (when (and (not= at :any) (not= at :truthy))
-                    (let [pe (assoc (all-any-env params) (nth params i) at)]
-                      (when (> (isolated-diag-count body pe) base)
-                        (swap! diag-box conj
-                               {:op :user-call :argpos i :type (type-name at) :pos pos
-                                :msg (str "argument " (inc i) " to `" (:name sig)
-                                          "` is " (type-name at)
-                                          ", which its body provably rejects")})))))
-                nil)
-              nil (range npar)))))
-      (reset! checking-box prev))))
+  Cycle-guarded (env's checking-set) so mutually recursive fns terminate."
+  [key sig arg-types pos env]
+  (let [cset (get env :checking-set)]
+    (when (not (contains? @cset key))
+      (let [prev @cset]
+        (reset! cset (conj prev key))
+        (let [params (:params sig)
+              body (:body sig)
+              npar (count params)
+              nargs (count arg-types)
+              memo (get env :diag-memo)]
+          (if (not= npar nargs)
+            ;; arity is provably wrong regardless of types — report and stop (the
+            ;; per-arg type re-check would bind params positionally, meaningless
+            ;; under a mismatch)
+            (swap! (get env :diags) conj
+                   {:op :user-call :type :arity :pos pos
+                    :msg (str "wrong number of args (" nargs ") passed to `"
+                              (:name sig) "` (expected " npar ")")})
+            ;; all-any-env is built once (was rebuilt per param), and each probe is
+            ;; memoized by [key i argtype] so the same fn re-checked across call
+            ;; sites in this form re-infers its body at most once per (param, type).
+            (let [base-env (all-any-env params)
+                  base (let [bk [:base key]]
+                         (if (contains? @memo bk)
+                           (get @memo bk)
+                           (let [b (isolated-diag-count body base-env env)]
+                             (swap! memo assoc bk b) b)))]
+              (reduce
+                (fn [_ i]
+                  (let [at (nth arg-types i)]
+                    (when (and (not= at :any) (not= at :truthy))
+                      (let [mk [:arg key i at]
+                            rejects (if (contains? @memo mk)
+                                      (get @memo mk)
+                                      (let [r (> (isolated-diag-count body (assoc base-env (nth params i) at) env) base)]
+                                        (swap! memo assoc mk r) r))]
+                        (when rejects
+                          (swap! (get env :diags) conj
+                                 {:op :user-call :argpos i :type (type-name at) :pos pos
+                                  :msg (str "argument " (inc i) " to `" (:name sig)
+                                            "` is " (type-name at)
+                                            ", which its body provably rejects")})))))
+                  nil)
+                nil (range npar)))))
+        (reset! cset prev)))))
 
 ;; --- Inter-procedural driver API consumed by the back end -------------------
 (defn set-rtenv!
   "Install the current return-type estimates (a map \"ns/name\" -> type) used to
   type call results during the fixpoint."
-  [m] (reset! rtenv-box m))
+  [m] (swap! config-box assoc :rtenv (or m {})))
 
 ;; install record-ctor shapes ("ns/->Name" -> [field-kw ...]) and the
 ;; map-shaping flag (opt-in JOLT_SHAPE), both read by infer.
-(defn set-record-shapes! [m] (reset! record-shapes-box (or m {})))
-(defn set-protocol-methods! [m] (reset! protocol-methods-box (or m {})))
-(defn set-map-shapes! [b] (reset! map-shapes-box (boolean b)))
+(defn set-record-shapes! [m] (swap! config-box assoc :record-shapes (or m {})))
+(defn set-protocol-methods! [m] (swap! config-box assoc :protocol-methods (or m {})))
+(defn set-map-shapes! [b] (swap! config-box assoc :map-shapes? (boolean b)))
 
 (defn set-vtypes!
   "Install var VALUE types (a map \"ns/name\" -> type): fn vars are :truthy
   (non-nil), def vars carry their inferred init type."
-  [m] (reset! vtype-box m))
+  [m] (swap! config-box assoc :vtypes (or m {})))
 
 (defn join-types
   "Public structural join (lub), used by the orchestrator's fixpoint so param/
@@ -752,17 +622,12 @@
   def must precede its call — the same ordering RFC 0005 already assumes."
   ([node] (check-form node false))
   ([node strict?]
-   (reset! strict-box (if strict? true false))
-   (reset! checking-box #{})
-   (reset! diag-box [])
-   ;; the check IS the inference: one walk that types and emits diagnostics
-   ;; (jolt audit). checking? gates emission so the optimization fixpoint, which
-   ;; also calls infer, stays silent.
-   (reset! checking? true)
-   (infer node {})
-   (reset! checking? false)
-   (reset! strict-box false)
-   (vec @diag-box)))
+   ;; the check IS the inference: one walk that types and emits diagnostics into
+   ;; this run's env. The optimization fixpoint runs with checking? false so it
+   ;; stays silent.
+   (let [env (mk-env true strict?)]
+     (infer node {} env)
+     (vec @(get env :diags)))))
 
 (defn infer-body
   "Type `body` under tenv (local-name -> type). Returns [ret-type node' calls],
@@ -770,9 +635,9 @@
   propagating into callee param types). Also accumulates escapes (read with
   collected-escapes after a full sweep)."
   [body tenv]
-  (reset! calls-box [])
-  (let [r (infer body tenv)]
-    [(nth r 0) (nth r 1) @calls-box]))
+  (let [env (mk-env false false)
+        r (infer body tenv env)]
+    [(nth r 0) (nth r 1) @(get env :calls)]))
 
 (defn reinfer-def
   "Re-run inference on a stashed :def's fn arity bodies with param types seeded
@@ -780,7 +645,9 @@
   end emits the result directly (no further passes), so the param-typed lookups
   keep their specialization. Used by the inter-procedural recompile."
   [def-node ptmap]
-  (let [fnode (get def-node :init)]
+  (let [fnode (get def-node :init)
+        env (mk-env false false)
+        shapes (get env :record-shapes)]
     (if (= :fn (get fnode :op))
       (assoc def-node :init
              (assoc fnode :arities
@@ -792,12 +659,12 @@
                             ;; as precise), so this only fills the gaps.
                             (let [pt (reduce (fn [m pr]
                                                (let [nm (nth pr 0)
-                                                     e (get @record-shapes-box (nth pr 1))]
+                                                     e (get shapes (nth pr 1))]
                                                  (if (and e (not (contains? m nm)))
-                                                   (assoc m nm (record-type-from-entry e type-depth))
+                                                   (assoc m nm (record-type-from-entry e type-depth shapes))
                                                    m)))
                                              ptmap (get a :phints))]
-                              (assoc a :body (nth (infer (get a :body) pt) 1))))
+                              (assoc a :body (nth (infer (get a :body) pt env) 1))))
                           (get fnode :arities))))
       def-node)))
 
@@ -812,11 +679,12 @@
   fixpoint, so a field read off it (e.g. (:origin ^Ray r)) never tells a shared
   callee its arg is a Vec3."
   [params phints]
-  (let [m (reduce (fn [acc pr] (assoc acc (nth pr 0) (nth pr 1))) {} phints)]
+  (let [shapes (get @config-box :record-shapes)
+        m (reduce (fn [acc pr] (assoc acc (nth pr 0) (nth pr 1))) {} phints)]
     (mapv (fn [nm]
             (let [ck (get m nm)
-                  e (and ck (get @record-shapes-box ck))]
-              (when e (record-type-from-entry e type-depth))))
+                  e (and ck (get shapes ck))]
+              (when e (record-type-from-entry e type-depth shapes))))
           params)))
 
 ;; Piggyback checking (jolt audit). In direct-link mode infer-top already runs
@@ -826,27 +694,22 @@
 ;; run-passes and reads take-diags! after. It checks the POST-optimization IR,
 ;; which matches what the optimized program actually evaluates (scalar-replace
 ;; only drops provably-pure code, an accepted opt-mode divergence).
-(def ^:private check-mode-box (atom {:on false :strict false}))
 (defn set-check-mode!
   "Enable/disable checking during the next run-passes inference (direct-link)."
   [on strict?] (reset! check-mode-box {:on (if on true false) :strict (if strict? true false)}))
 (defn take-diags!
   "Diagnostics accumulated by the last checking run-passes; clears the buffer."
-  [] (let [d (vec @diag-box)] (reset! diag-box []) d))
+  [] (let [d @last-diags-box] (reset! last-diags-box []) d))
 
 (defn run-inference
   "Type-infer the optimized node (the inference walk specializes struct-safe
   lookups). When check mode is on (set-check-mode!), the same walk also emits
-  success-type diagnostics into the buffer take-diags! drains afterward. Pulled
+  success-type diagnostics, stashed for take-diags! to drain afterward. Pulled
   out of run-passes so the checking state stays private to this namespace."
   [opt]
   (if (get @check-mode-box :on)
-    (do (reset! diag-box [])
-        (reset! checking-box #{})
-        (reset! strict-box (get @check-mode-box :strict))
-        (reset! checking? true)
-        (let [r (infer-top opt)]
-          (reset! checking? false)
-          (reset! strict-box false)
-          r))
-    (infer-top opt)))
+    (let [env (mk-env true (get @check-mode-box :strict))
+          r (infer-top opt env)]
+      (reset! last-diags-box @(get env :diags))
+      r)
+    (infer-top opt (mk-env false false))))

jolt-core/jolt/passes/types/lattice.clj

@@ -0,0 +1,156 @@
+(ns jolt.passes.types.lattice
+  "Structural type lattice for jolt.passes.types: scalar/struct/vec/set/union
+  types, join, depth-cap, shape, and the numeric/vector return-fn name sets. Pure
+  (no inference state) — the inference + checker in jolt.passes.types build on it.")
+
+;; ---------------------------------------------------------------------------
+;; Collection-type inference, intra-procedural. A forward,
+;; soft-typing-style pass (simplified HM: monovariant, never-fails, lattice top
+;; = :any) that types expressions from literals/arithmetic and flows the type
+;; through let bindings and if-joins. Where a keyword-lookup subject is PROVEN a
+;; plain struct map it sets :hint :struct (the same channel a manual hint uses,
+;; so the back end drops the guard); where the type is :any it leaves the
+;; dynamic guard in place. Sound by construction: a concrete type is assigned
+;; only when proven, so a wrong bare get is impossible.
+;;
+;; Recursive STRUCTURAL types (RFC 0005). A type mirrors the data tree:
+;;   compound: {:struct {field -> T}}  (raw-get-safe map, field types)
+;;             {:vec T}                (vector of T)
+;;             {:set T}                (set of T)
+;;   scalar:   :num :str :kw :truthy   (all provably non-nil/non-false)
+;;             :phm                    (persistent hash map; NOT raw-get-safe)
+;;   :any (top), nil (bottom, identity for join).
+;; Compound types are small jolt maps, so they compare by value on both the
+;; Clojure and the host (orchestrator) side. struct/vec/set use distinct keys so
+;; a type is recognised by which key it carries.
+;; (get t :KEY) is nil for a keyword type and the child for a compound, so a
+;; compound is detected by some? — no map?/contains? needed.
+(defn velem [t] (get t :vec))
+(defn selem [t] (get t :set))
+(defn sfields [t] (get t :struct))
+(defn vec-type? [t] (some? (velem t)))
+(defn set-type? [t] (some? (selem t)))
+(defn struct-type? [t] (some? (sfields t)))
+(defn mk-vec [t] {:vec (if t t :any)})
+(defn mk-set [t] {:set (if t t :any)})
+(defn mk-struct [fs] {:struct fs})
+
+;; Bounded union types (RFC 0006). A union {:union #{T...}} records
+;; that a value is provably one of a small, fixed set of SCALAR types — what
+;; differing if-branches used to collapse to :any. It exists so the success
+;; checker can reject a use where EVERY member is in the op's error domain
+;; ((inc (if c "a" :k))) while still accepting one where any member is valid
+;; ((inc (if c 1 "x"))). Scalars only, capped cardinality: the member space is
+;; the five scalar tags, so the lattice stays finite and the inter-procedural
+;; fixpoint terminates. A union is opaque to every STRUCTURAL predicate
+;; (struct-type?/vec-type?/set-type? key on :struct/:vec/:set, which a union
+;; lacks), so specialization treats it exactly like :any — codegen is
+;; unchanged; only the checker reads inside it.
+(def union-cap 4)
+(defn scalar-t? [t] (or (= t :num) (= t :str) (= t :kw) (= t :truthy) (= t :phm)))
+(defn union-type? [t] (some? (get t :union)))
+(defn umembers [t] (get t :union))
+(defn union-of
+  "Normalize a seq of member types into a lattice value: flatten nested unions,
+  keep only scalars (any non-scalar member collapses the whole thing to :any,
+  the conservative top), then return the lone member if one, {:union #{...}}
+  for 2..cap distinct scalars, or :any past the cap."
+  [ts]
+  (let [flat (reduce (fn [acc t]
+                       (if (union-type? t)
+                         (reduce conj acc (umembers t))
+                         (conj acc t)))
+                     #{} ts)]
+    (cond
+      (not (every? scalar-t? flat)) :any
+      (= 0 (count flat)) :any
+      (= 1 (count flat)) (first flat)
+      (> (count flat) union-cap) :any
+      :else {:union flat})))
+
+(declare join-t)
+(defn merge-fields
+  "Per-field join of two field maps (a key in only one side joins with :any)."
+  [fa fb]
+  (let [m1 (reduce (fn [m k] (assoc m k (join-t (get fa k :any) (get fb k :any)))) {} (keys fa))]
+    (reduce (fn [m k] (if (get m k) m (assoc m k (join-t (get fa k :any) (get fb k :any))))) m1 (keys fb))))
+(defn join-t [a b]
+  (cond
+    (= a b) a
+    (nil? a) b
+    (nil? b) a
+    (and (struct-type? a) (struct-type? b))
+      (let [merged (mk-struct (merge-fields (sfields a) (sfields b)))]
+        ;; joining two values of the SAME complete shape preserves it — the
+        ;; merged struct has the same key set. Different shapes
+        ;; (or an incomplete side) drop it, as the layout is no longer proven.
+        (if (and (get a :shape) (= (get a :shape) (get b :shape)))
+          (assoc merged :shape (get a :shape))
+          merged))
+    (and (vec-type? a) (vec-type? b)) (mk-vec (join-t (velem a) (velem b)))
+    (and (set-type? a) (set-type? b)) (mk-set (join-t (selem a) (selem b)))
+    ;; differing kinds: form a scalar union when both sides reduce to scalars
+    ;; (or scalar unions); anything compound on either side stays :any
+    :else (let [ma (cond (union-type? a) (umembers a) (scalar-t? a) #{a} :else nil)
+                mb (cond (union-type? b) (umembers b) (scalar-t? b) #{b} :else nil)]
+            (if (and ma mb) (union-of (reduce conj ma mb)) :any))))
+(defn join [a b] (join-t a b))
+;; depth cap (RFC 0005): truncate a type below depth d to :any, so recursive data
+;; can't make an infinite type and the inter-procedural fixpoint stays finite.
+(def type-depth 4)
+(defn cap [t d]
+  (cond
+    (<= d 0) (if (or (struct-type? t) (vec-type? t) (set-type? t)) :any t)
+    (struct-type? t)
+      ;; capping truncates VALUES below depth d, but the KEY SET is unchanged, so
+      ;; a complete :shape survives — keep it so nested/container field reads can
+      ;; still bare-index. cap recurses into fields, so a nested
+      ;; shaped value (a vec3 inside a hit-info) keeps its own :shape too.
+      (let [capped (mk-struct (reduce (fn [m k] (assoc m k (cap (get (sfields t) k) (dec d))))
+                                      {} (keys (sfields t))))
+            ;; the record :type tag (and :shape) are independent of field-value
+            ;; depth, so they survive truncation — a record read from a deep
+            ;; container keeps its identity, so devirtualization, record? folding,
+            ;; and the record fast path still fire on it.
+            capped (if (get t :shape) (assoc capped :shape (get t :shape)) capped)
+            capped (if (get t :type) (assoc capped :type (get t :type)) capped)]
+        capped)
+    (vec-type? t) (mk-vec (cap (velem t) (dec d)))
+    (set-type? t) (mk-set (cap (selem t) (dec d)))
+    :else t))
+;; raw-get-safe (a struct / record): a struct type. The field type of key
+;; k, if known, else :any.
+(defn struct-safe? [t] (struct-type? t))
+(defn field-type [t k] (if (struct-type? t) (get (sfields t) k :any) :any))
+;; Shape (hidden class). A struct type built from a map LITERAL carries
+;; its complete layout — :shape, the canonical (str-sorted) key vector. The back
+;; end represents such a map as a shape tuple and reads a field by bare index.
+;; A struct type from a JOIN or from field-access inference has no :shape
+;; (incomplete: the full key set isn't proven), so it keeps the dynamic path —
+;; never a bare index. No shape is hardcoded; any constant key set is one.
+(defn shape-order
+  "Canonical key order for a shape: keys sorted by their string form, so two
+  literals with the same keys in any order intern to the same shape."
+  [ks] (vec (sort (fn [a b] (compare (str a) (str b))) ks)))
+(defn type-shape [t] (get t :shape))
+;; tag a node (any expression, not just a :local) so the back end can specialize
+;; a lookup whose SUBJECT is that node — this is what makes nested access work:
+;; (:direction ray) is tagged struct, so (:r (:direction ray)) drops its guard.
+;; tag a lookup subject as a struct, carrying the complete shape when known
+;; (so the back end bare-indexes).
+(defn mark-struct [node t]
+  (let [n (assoc node :hint :struct)]
+    (if (get t :shape) (assoc n :shape (get t :shape)) n)))
+;; a value provably neither nil nor false — the back end only builds a struct
+;; (vs a phm) when every value is non-nil/non-false, so a map literal is a struct
+;; only when all its values have such a type. Collections are non-nil.
+(defn truthy-type? [t]
+  (or (= t :num) (= t :str) (= t :kw) (= t :truthy) (= t :phm)
+      (struct-type? t) (vec-type? t) (set-type? t)))
+
+;; core fns whose result is a number (so it is non-nil/non-false and, for the
+;; success-type checker, provably numeric).
+(def num-ret-fns
+  #{"+" "-" "*" "/" "inc" "dec" "mod" "rem" "quot" "min" "max" "abs"
+    "bit-and" "bit-or" "bit-xor" "count"})
+(def vector-ret-fns #{"vec" "vector" "mapv" "filterv" "subvec"})

jolt-core/jolt/reader.clj

@@ -1,463 +0,0 @@
-(ns jolt.reader
-  "Reads Clojure source text into reader forms.
-
-  The lexing and parsing is portable Clojure; form construction and
-  string->number parsing delegate to the jolt.host contract (form-make-symbol/
-  char, form-char-from-name, form-scan-number). A Clojure source file can't write
-  a {:jolt/type :symbol} literal — it would parse as a tagged reader form — and
-  the concrete form representation belongs to the host. The analyzer uses the same
-  split. Once cross-compiled this runs on Chez to drive compile-from-source.
-
-  Positions are character indices; for ASCII source they coincide with byte
-  indices, and form values are identical either way — the parity gate compares
-  values, not positions."
-  (:require [clojure.string :as str]
-            [jolt.host :refer [form-make-symbol form-make-char form-char-from-name
-                               form-scan-number form-make-list form-make-vector
-                               form-make-map form-sym-merge-meta form-make-set
-                               form-make-tagged form-gensym-name
-                               form-sym? form-sym-name form-sym-ns form-char?
-                               form-list? form-vec? form-set? form-map?
-                               form-elements form-vec-items form-set-items
-                               form-map-pairs]]))
-
-;; Source access by CHARACTER codepoint
-;; (identical to byte access for ASCII). cp = codepoint at i; len = character count.
-(defn- cp [s i] (int (nth s i)))
-(defn- len [s] (count s))
-
-(defn- whitespace? [c] (or (= c 32) (= c 9) (= c 10) (= c 13) (= c 44)))  ; space tab nl cr ,
-(defn- digit? [c] (and (>= c 48) (<= c 57)))
-(defn- hex-digit? [c]
-  (or (digit? c) (and (>= c 65) (<= c 70)) (and (>= c 97) (<= c 102))))
-(defn- symbol-start? [c]
-  (or (and (>= c 65) (<= c 90)) (and (>= c 97) (<= c 122))
-      (= c 42) (= c 43) (= c 33) (= c 95) (= c 45) (= c 63) (= c 46)
-      (= c 60) (= c 62) (= c 61) (= c 38) (= c 124) (= c 36) (= c 37) (= c 47)))
-(defn- symbol-char? [c]
-  (or (symbol-start? c) (digit? c) (= c 35) (= c 39) (= c 58)))  ; + # ' :
-
-(defn- skip-whitespace [s pos]
-  (if (and (< pos (len s)) (whitespace? (cp s pos)))
-    (recur s (inc pos))
-    pos))
-
-(defn- read-until-newline [s pos]
-  (if (or (>= pos (len s)) (= (cp s pos) 10)) pos (recur s (inc pos))))
-
-;; --- symbols -----------------------------------------------------------------
-(defn- read-symbol-name [s pos end]
-  (if (and (< end (len s)) (symbol-char? (cp s end))) (recur s pos (inc end)) end))
-
-(defn- read-symbol* [s pos]
-  (let [end (read-symbol-name s pos pos)]
-    (when (= end pos)
-      (throw (ex-info (str "Unrecognized character: " (char (cp s pos))) {})))
-    (let [nm (subs s pos end)]
-      (cond
-        (= nm "nil") [nil end]
-        (= nm "true") [true end]
-        (= nm "false") [false end]
-        :else [(form-make-symbol nm) end]))))
-
-;; --- keywords ----------------------------------------------------------------
-(defn- read-keyword-name [s pos end]
-  (if (and (< end (len s)) (symbol-char? (cp s end))) (recur s pos (inc end)) end))
-
-(defn- read-keyword* [s pos]
-  ;; pos is at the first colon; ::foo is treated as :foo (no auto-resolution).
-  (let [start (if (and (< (inc pos) (len s)) (= (cp s (inc pos)) 58)) (+ pos 2) (inc pos))
-        end (read-keyword-name s start start)]
-    [(keyword (subs s start end)) end]))
-
-;; --- strings -----------------------------------------------------------------
-(defn- escape-char [c]
-  (cond (= c 110) "\n" (= c 116) "\t" (= c 114) "\r" (= c 92) "\\" (= c 34) "\""
-        :else (str (char c))))
-
-(defn- read-string* [s pos]
-  ;; pos at opening double-quote
-  (loop [p (inc pos) acc []]
-    (when (>= p (len s)) (throw (ex-info "Unterminated string" {})))
-    (let [c (cp s p)]
-      (cond
-        (= c 92) (let [np (inc p)]
-                   (when (>= np (len s)) (throw (ex-info "Unterminated escape" {})))
-                   (recur (+ p 2) (conj acc (escape-char (cp s np)))))
-        (= c 34) [(apply str acc) (inc p)]
-        :else (recur (inc p) (conj acc (str (char c))))))))
-
-;; --- numbers -----------------------------------------------------------------
-(defn- read-digits [s pos end]
-  (if (and (< end (len s)) (digit? (cp s end))) (recur s pos (inc end)) end))
-(defn- read-hex-digits [s pos end]
-  (if (and (< end (len s)) (hex-digit? (cp s end))) (recur s pos (inc end)) end))
-
-;; Value of an alphanumeric digit for radix parsing (0-9, a-z/A-Z = 10-35).
-(defn- radix-digit-val [c]
-  (cond
-    (and (>= c 48) (<= c 57)) (- c 48)
-    (and (>= c 97) (<= c 122)) (+ 10 (- c 97))
-    (and (>= c 65) (<= c 90)) (+ 10 (- c 65))
-    :else nil))
-(defn- read-alnum [s pos end]
-  (if (and (< end (len s)) (radix-digit-val (cp s end))) (recur s pos (inc end)) end))
-
-(defn- read-exponent [s end]
-  ;; if s[end] is e/E (optionally signed) followed by digits, return index past it
-  (if (and (< end (len s)) (let [c (cp s end)] (or (= c 101) (= c 69))))
-    (let [p (if (and (< (inc end) (len s)) (let [c (cp s (inc end))] (or (= c 43) (= c 45))))
-              (+ end 2) (inc end))
-          de (read-digits s p p)]
-      (if (> de p) de end))
-    end))
-
-;; Jolt has no bignum/ratio: N (bigint) / M (bigdec) suffixes read as the plain
-;; number, a ratio a/b reads as the double quotient, radixed ints by base.
-(defn- read-number* [s pos]
-  (let [length (len s)
-        ;; optional leading sign: - negates; + is a positive no-op (Clojure reads
-        ;; +5 as 5). read-form only dispatches +digit/-digit, so the sign is real.
-        neg (and (< pos length) (= (cp s pos) 45))
-        plus (and (< pos length) (= (cp s pos) 43))
-        start (if (or neg plus) (inc pos) pos)
-        hex? (and (< (inc start) length) (= (cp s start) 48)
-                  (let [c1 (cp s (inc start))] (or (= c1 120) (= c1 88))))]  ; 0x / 0X
-    (if hex?
-      (let [hs (+ start 2) he (read-hex-digits s hs hs)]
-        (when (= he hs) (throw (ex-info "Expected hex digits" {})))
-        (let [he2 (if (and (< he length) (= (cp s he) 78)) (inc he) he)   ; trailing N
-              val (form-scan-number (str "0x" (subs s hs he)))]
-          [(if neg (- val) val) he2]))
-      (let [iend (read-digits s start start)]
-        (when (= iend start) (throw (ex-info "Expected number" {})))
-        (cond
-          ;; radix integer <base>r<digits>
-          (and (< iend length) (let [c (cp s iend)] (or (= c 114) (= c 82))))
-          (let [base (form-scan-number (subs s start iend))
-                ds (inc iend) de (read-alnum s ds ds)]
-            (when (= de ds) (throw (ex-info "Expected radix digits" {})))
-            (let [acc (reduce (fn [a i] (+ (* a base) (radix-digit-val (cp s i)))) 0 (range ds de))]
-              [(if neg (- acc) acc) de]))
-          ;; ratio <int>/<int> (only when a digit follows the slash)
-          (and (< (inc iend) length) (= (cp s iend) 47) (digit? (cp s (inc iend))))
-          (let [ds (inc iend) de (read-digits s ds ds)
-                numr (form-scan-number (subs s start iend))
-                den (form-scan-number (subs s ds de))]
-            [(if neg (- (/ numr den)) (/ numr den)) de])
-          ;; fractional and/or exponent, optional trailing N/M
-          :else
-          (let [frac-end (if (and (< iend length) (= (cp s iend) 46))
-                           (let [fs (inc iend) fe (read-digits s fs fs)]
-                             (when (= fe fs) (throw (ex-info "Expected digit after ." {})))
-                             fe)
-                           iend)
-                exp-end (read-exponent s frac-end)
-                val (form-scan-number (subs s start exp-end))
-                fin (if (and (< exp-end length) (let [c (cp s exp-end)] (or (= c 78) (= c 77))))
-                      (inc exp-end) exp-end)]
-            [(if neg (- val) val) fin]))))))
-
-;; --- characters --------------------------------------------------------------
-(defn- read-char-name-end [s pos]
-  (if (and (< pos (len s)) (symbol-char? (cp s pos))) (recur s (inc pos)) pos))
-
-(defn- read-char* [s pos]
-  (when (>= (inc pos) (len s)) (throw (ex-info "unexpected end of input after \\" {})))
-  (let [end (read-char-name-end s (inc pos))]
-    (if (= end (inc pos))
-      ;; a non-symbol char right after \ is a one-character literal of itself
-      [(form-make-char (cp s (inc pos))) (+ pos 2)]
-      [(form-char-from-name (subs s (inc pos) end)) end])))
-
-;; --- dispatcher --------------------------------------------------------------
-;; read-form returns a CONTROL triple [kind payload pos]:
-;;   :form  payload=the form          a real datum
-;;   :skip  payload=nil               a comment (;) or #_ discard — produced nothing
-;;   :splice payload=items-vector     #?@ — contributes 0+ items to the enclosing coll
-;; Out-of-band control (rather than :jolt/skip / :jolt/splice sentinel
-;; FORMS) keeps it collision-free and host-neutral — no tagged-struct to build or
-;; recognize. Collection readers dispatch on kind; read-next-form skips :skip.
-(declare read-form)
-
-(defn- number-start? [s pos c]
-  (or (digit? c)
-      (and (= c 45) (< (inc pos) (len s)) (digit? (cp s (inc pos))))
-      (and (= c 43) (< (inc pos) (len s)) (digit? (cp s (inc pos))))))
-
-;; Read items until `close`, dispatching control kinds. Returns [items-vec end].
-(defn- read-delimited [s start-pos close errmsg]
-  (loop [pos start-pos items []]
-    (let [pos (skip-whitespace s pos)]
-      (when (>= pos (len s)) (throw (ex-info errmsg {})))
-      (if (= (cp s pos) close)
-        [items (inc pos)]
-        (let [[kind payload np] (read-form s pos)]
-          (case kind
-            :skip (recur np items)
-            :splice (recur np (into items payload))
-            :form (recur np (conj items payload))))))))
-
-(defn- read-list* [s pos]
-  (let [[items end] (read-delimited s (inc pos) 41 "Unterminated list")]   ; )
-    [:form (form-make-list items) end]))
-
-(defn- read-vector* [s pos]
-  (let [[items end] (read-delimited s (inc pos) 93 "Unterminated vector")] ; ]
-    [:form (form-make-vector items) end]))
-
-;; Map: pair up keys and values, skipping comments/#_ in either slot while keeping
-;; the pending key (dropping both desyncs the pairing). A key/value is always a
-;; single :form (or :skip) — splice in a map slot is not supported.
-(defn- read-map* [s pos]
-  (loop [pos (inc pos) kvs []]
-    (let [pos (skip-whitespace s pos)]
-      (when (>= pos (len s)) (throw (ex-info "Unterminated map" {})))
-      (if (= (cp s pos) 125)   ; }
-        [:form (form-make-map kvs) (inc pos)]
-        (let [[kk kp knp] (read-form s pos)]
-          (if (= kk :skip)
-            (recur knp kvs)
-            ;; key in hand; read the value slot, skipping trivia but keeping the key
-            (let [[v vnp]
-                  (loop [vp (skip-whitespace s knp)]
-                    (when (>= vp (len s)) (throw (ex-info "Unterminated map" {})))
-                    (let [[vk vp2 vnp2] (read-form s vp)]
-                      (if (= vk :skip) (recur (skip-whitespace s vnp2)) [vp2 vnp2])))]
-              (recur vnp (conj (conj kvs kp) v)))))))))
-
-;; Read the next REAL form (skip :skip), returning [form pos]. Used wherever a
-;; single datum is needed (quote/meta/top level).
-(defn- read-next-form [s pos]
-  (let [[kind payload np] (read-form s pos)]
-    (case kind
-      :skip (recur s np)
-      :form [payload np]
-      :splice (throw (ex-info "splice (#?@) not inside a collection" {})))))
-
-;; syntax-quote of a self-evaluating literal collapses to the literal at read time
-;; (so nested backticks over literals are inert). NOT symbols (they qualify) or
-;; collections (they template).
-(defn- self-evaluating-literal? [form]
-  (or (nil? form) (true? form) (false? form) (number? form)
-      (string? form) (keyword? form) (form-char? form)))
-
-(defn- read-quote* [s newpos token-sym]
-  (let [[form finalpos] (read-next-form s newpos)]
-    (if (and (= "syntax-quote" (form-sym-name token-sym)) (self-evaluating-literal? form))
-      [:form form finalpos]
-      [:form (form-make-list [token-sym form]) finalpos])))
-
-;; Normalize a metadata reader form: keyword -> {kw true}; symbol/string -> {:tag …}
-;; (a symbol tag keeps its ns qualifier); else nil (a map-literal meta).
-(defn- meta-form->map [meta-form]
-  (cond
-    (keyword? meta-form) {meta-form true}
-    (form-sym? meta-form) {:tag (if (form-sym-ns meta-form)
-                                  (str (form-sym-ns meta-form) "/" (form-sym-name meta-form))
-                                  (form-sym-name meta-form))}
-    (string? meta-form) {:tag meta-form}
-    :else nil))
-
-(defn- read-meta* [s pos]
-  ;; pos at ^
-  (let [[meta-form np] (read-next-form s (inc pos))
-        [form np2] (read-next-form s np)
-        m (meta-form->map meta-form)]
-    (if (and m (form-sym? form))
-      ;; attach to the symbol itself (^Type x / ^:dynamic) — stays a bare symbol
-      [:form (form-sym-merge-meta form m) np2]
-      ;; non-symbol target -> a runtime with-meta form (normalized map, or the
-      ;; raw map-literal meta when m is nil)
-      [:form (form-make-list [(form-make-symbol "with-meta") form (if m m meta-form)]) np2])))
-
-;; --- dispatch (#) ------------------------------------------------------------
-;; Reader-conditional feature set (spec 02-reader). jolt's portable default; the
-;; JOLT_FEATURES env override is a host concern wired later. :default always honored.
-(def reader-features (atom #{:jolt :default}))
-(defn set-reader-features! [features] (reset! reader-features (conj (set features) :default)))
-
-(defn- read-set* [s pos]
-  ;; pos at #, next char {
-  (let [[items end] (read-delimited s (+ pos 2) 125 "Unterminated set")]  ; }
-    [:form (form-make-set items) end]))
-
-(defn- read-var-quote* [s pos]
-  ;; pos at #, next char '
-  (let [[form np] (read-next-form s (+ pos 2))]
-    [:form (form-make-list [(form-make-symbol "var") form]) np]))
-
-(defn- read-regex* [s pos]
-  ;; pos at #, next char "; read raw to the unescaped closing " (backslashes kept)
-  (loop [i (+ pos 2)]
-    (when (>= i (len s)) (throw (ex-info "Unterminated regex literal" {})))
-    (let [c (cp s i)]
-      (cond
-        (= c 92) (recur (+ i 2))   ; backslash escapes next char
-        (= c 34) [:form (form-make-tagged :regex (subs s (+ pos 2) i)) (inc i)]
-        :else (recur (inc i))))))
-
-;; #?(…) / #?@(…): pick the first clause whose feature key is active (clause order,
-;; like Clojure). #? -> :skip when the result is nil (e.g. a :cljs branch); #?@ ->
-;; :splice the resolved items into the enclosing collection.
-(defn- rc-resolve [clauses]
-  ;; clauses: a jolt vector of [feature-kw form feature-kw form ...]
-  (loop [i 0]
-    (if (>= i (count clauses))
-      [false nil]
-      (if (contains? @reader-features (nth clauses i))
-        [true (nth clauses (inc i))]
-        (recur (+ i 2))))))
-
-(defn- read-reader-conditional* [s pos]
-  ;; pos at #, next char ? (optionally ?@)
-  (let [splice? (and (< (+ pos 2) (len s)) (= (cp s (+ pos 2)) 64))  ; @
-        form-start (if splice? (+ pos 3) (+ pos 2))
-        [form np] (read-next-form s form-start)]
-    (if (form-list? form)
-      (let [clauses (form-elements form)
-            [matched result] (rc-resolve clauses)]
-        (if splice?
-          (let [items (cond (not matched) []
-                            (form-list? result) (vec (form-elements result))
-                            (form-vec? result) (vec (form-vec-items result))
-                            :else [result])]
-            [:splice items np])
-          (if (or (not matched) (nil? result)) [:skip nil np] [:form result np])))
-      (throw (ex-info "reader conditional body must be a list" {})))))
-
-;; Symbolic values ##Inf ##-Inf ##NaN.
-(defn- read-symbolic* [s pos]
-  (let [end (read-symbol-name s (+ pos 2) (+ pos 2))
-        nm (subs s (+ pos 2) end)]
-    (cond
-      (= nm "Inf") [:form ##Inf end]
-      (= nm "-Inf") [:form ##-Inf end]
-      (= nm "NaN") [:form ##NaN end]
-      :else (throw (ex-info (str "Invalid symbolic value: ##" nm) {})))))
-
-(defn- read-tagged* [s pos]
-  ;; unknown dispatch -> a tagged literal (#inst, #uuid, #foo). The tag includes
-  ;; the leading # (read-symbol-name starts at #).
-  (let [end (read-symbol-name s pos pos)
-        tag (subs s pos end)
-        [form np] (read-next-form s end)]
-    [:form (form-make-tagged (keyword tag) form) np]))
-
-(declare read-anon-fn*)
-
-(defn- read-dispatch* [s pos]
-  ;; pos at #
-  (when (>= (inc pos) (len s)) (throw (ex-info "Unexpected end after #" {})))
-  (let [c (cp s (inc pos))]
-    (cond
-      (= c 123) (read-set* s pos)                 ; #{
-      (= c 40) (read-anon-fn* s pos)              ; #(
-      (= c 63) (read-reader-conditional* s pos)   ; #?
-      (= c 95) (let [[_ _ np] (read-form s (+ pos 2))] [:skip nil np])  ; #_ discard
-      (= c 39) (read-var-quote* s pos)            ; #'
-      (= c 94) (read-meta* s (inc pos))           ; #^ (deprecated, = ^)
-      (= c 34) (read-regex* s pos)                ; #"
-      (= c 35) (read-symbolic* s pos)             ; ##
-      :else (read-tagged* s pos))))
-
-;; #(...) anonymous fn. Positional %-arg index: % and %1 => 1, %N => N, %& => the
-;; rest param (:rest); anything else is not positional (nil). Fixed arity = max
-;; index used (Clojure: #(do %2 %&) => [p1 p2 & rest], unused lower slots still
-;; get a placeholder param).
-(defn- pct-index [nm]
-  (cond
-    (= nm "%") 1
-    (= nm "%&") :rest
-    (and (> (count nm) 1) (= "%" (subs nm 0 1)))
-    (let [n (form-scan-number (subs nm 1))]
-      (if (and n (integer? n) (>= n 1)) n nil))
-    :else nil))
-
-;; Pass 1: collect every %-index used anywhere in the form tree.
-(defn- collect-pcts [form acc]
-  (cond
-    (form-sym? form) (let [i (pct-index (form-sym-name form))] (if i (conj acc i) acc))
-    (form-list? form) (reduce (fn [a x] (collect-pcts x a)) acc (form-elements form))
-    (form-vec? form) (reduce (fn [a x] (collect-pcts x a)) acc (form-vec-items form))
-    (form-set? form) (reduce (fn [a x] (collect-pcts x a)) acc (form-set-items form))
-    (form-map? form) (reduce (fn [a p] (collect-pcts (nth p 1) (collect-pcts (nth p 0) a)))
-                             acc (form-map-pairs form))
-    :else acc))
-
-;; Pass 2: replace each %-symbol with its slot's gensym (rebuilding collections).
-(defn- replace-pct [form slot-syms rest-sym]
-  (cond
-    (form-sym? form) (let [idx (pct-index (form-sym-name form))]
-                       (cond (= idx :rest) rest-sym
-                             idx (get slot-syms idx)
-                             :else form))
-    (form-list? form) (form-make-list (mapv #(replace-pct % slot-syms rest-sym) (form-elements form)))
-    (form-vec? form) (form-make-vector (mapv #(replace-pct % slot-syms rest-sym) (form-vec-items form)))
-    (form-set? form) (form-make-set (mapv #(replace-pct % slot-syms rest-sym) (form-set-items form)))
-    (form-map? form) (form-make-map
-                       (vec (mapcat (fn [p] [(replace-pct (nth p 0) slot-syms rest-sym)
-                                             (replace-pct (nth p 1) slot-syms rest-sym)])
-                                    (form-map-pairs form))))
-    :else form))
-
-(defn- gensym-param [] (form-make-symbol (str (form-gensym-name) "#")))
-
-(defn- read-anon-fn* [s pos]
-  ;; pos at #, next char (
-  (let [[form np] (read-next-form s (inc pos))
-        pcts (collect-pcts form [])
-        max-n (reduce (fn [m i] (if (and (number? i) (> i m)) i m)) 0 pcts)
-        has-rest (boolean (some #(= :rest %) pcts))
-        slot-syms (into {} (map (fn [i] [i (gensym-param)]) (range 1 (inc max-n))))
-        rest-sym (when has-rest (gensym-param))
-        replaced (replace-pct form slot-syms rest-sym)
-        arg-names (let [base (mapv #(get slot-syms %) (range 1 (inc max-n)))]
-                    (if has-rest (conj base (form-make-symbol "&") rest-sym) base))]
-    [:form (form-make-list [(form-make-symbol "fn*") (form-make-vector arg-names) replaced]) np]))
-
-(defn read-form [s pos]
-  (let [pos (skip-whitespace s pos)]
-    (if (>= pos (len s))
-      [:form nil pos]
-      (let [c (cp s pos)]
-        (cond
-          (= c 59) [:skip nil (read-until-newline s pos)]              ; ; comment
-          (= c 34) (let [r (read-string* s pos)] [:form (nth r 0) (nth r 1)])
-          (= c 58) (let [r (read-keyword* s pos)] [:form (nth r 0) (nth r 1)])
-          (= c 92) (let [r (read-char* s pos)] [:form (nth r 0) (nth r 1)])
-          (= c 40) (read-list* s pos)                                  ; (
-          (= c 91) (read-vector* s pos)                                ; [
-          (= c 123) (read-map* s pos)                                  ; {
-          (= c 39) (read-quote* s (inc pos) (form-make-symbol "quote"))            ; '
-          (= c 96) (read-quote* s (inc pos) (form-make-symbol "syntax-quote"))     ; `
-          (= c 126) (if (and (< (inc pos) (len s)) (= (cp s (inc pos)) 64))        ; ~ / ~@
-                      (read-quote* s (+ pos 2) (form-make-symbol "unquote-splicing"))
-                      (read-quote* s (inc pos) (form-make-symbol "unquote")))
-          (= c 64) (read-quote* s (inc pos) (form-make-symbol "clojure.core/deref")) ; @
-          (= c 94) (read-meta* s pos)                                  ; ^
-          (= c 41) (throw (ex-info "Unmatched delimiter: )" {}))
-          (= c 93) (throw (ex-info "Unmatched delimiter: ]" {}))
-          (= c 125) (throw (ex-info "Unmatched delimiter: }" {}))
-          (= c 35) (read-dispatch* s pos)                             ; #
-          (number-start? s pos c) (let [r (read-number* s pos)] [:form (nth r 0) (nth r 1)])
-          (symbol-start? c) (let [r (read-symbol* s pos)] [:form (nth r 0) (nth r 1)])
-          :else (throw (ex-info (str "read-form: unexpected char '" (char c) "' (" c ")") {})))))))
-
-(defn read-one
-  "Read the first form of `s` (skipping leading trivia). Returns the form."
-  [s]
-  (first (read-next-form s 0)))
-
-(defn read-all
-  "Read every top-level form of `s`, returning them in a vector (trivia skipped)."
-  [s]
-  (loop [pos 0 acc []]
-    (let [p (skip-whitespace s pos)]
-      (if (>= p (len s))
-        acc
-        (let [[kind payload np] (read-form s p)]
-          (case kind
-            :skip (recur np acc)
-            :splice (recur np (into acc payload))
-            :form (recur np (conj acc payload))))))))

stdlib/clojure/edn.clj

@@ -55,12 +55,10 @@
   PushbackReader, io/reader results) expose char-wise .read; a raw file
   handle is read whole."
   [reader]
-  (if (= :core/file (janet/type reader))
-    (janet.file/read reader :all)
-    (loop [acc (transient []) c (.read reader)]
-      (if (== -1 c)
-        (apply str (map char (persistent! acc)))
-        (recur (conj! acc c) (.read reader))))))
+  (loop [acc (transient []) c (.read reader)]
+    (if (== -1 c)
+      (apply str (map char (persistent! acc)))
+      (recur (conj! acc c) (.read reader)))))
 
 (defn read
   "Reads one EDN object from reader (a PushbackReader or any jolt reader).

stdlib/clojure/string.clj

@@ -96,15 +96,6 @@
   [s]
   (str-trimr s))
 
-(defn trim-newline
-  
-  [s]
-  (var result s)
-  (while (or (= (subs result (dec (count result))) "\n")
-             (= (subs result (dec (count result))) "\r"))
-    (set result (subs result 0 (dec (count result)))))
-  result)
-
 (defn escape
   
   [s cmap]