From b3d0a91e3e9fcf630b08362e875e7224f4e4fed4 Mon Sep 17 00:00:00 2001
From: Yogthos <yogthos@gmail.com>
Date: Wed, 17 Jun 2026 13:10:19 -0400
Subject: [PATCH] Chez Phase 0c + 0a hardening: collections decision +
 value-model fixes

0c: persistent HAMT on Chez is ~41x faster than Janet's HAMT on the collections
map-churn (258.6 -> 6.3 ms), ~15x off mutable-native (inherent persistence cost).
Decision: self-host the persistent collections in Clojure; substrate is not the
bottleneck. See docs/chez-phase0-results.md.

0a hardening: NUL-separated keyword intern key (no ns/name collision), non-finite
-safe jolt-hash. 37/37.
---
 docs/chez-phase0-results.md          |  48 +++++++++++
 host/chez/values.ss                  |  11 ++-
 spike/chez/collections-experiment.ss | 119 +++++++++++++++++++++++++++
 test/chez/values-test.ss             |   7 ++
 4 files changed, 183 insertions(+), 2 deletions(-)
 create mode 100644 docs/chez-phase0-results.md
 create mode 100644 spike/chez/collections-experiment.ss

diff --git a/docs/chez-phase0-results.md b/docs/chez-phase0-results.md
new file mode 100644
index 0000000..4a1bd2a
--- /dev/null
+++ b/docs/chez-phase0-results.md
@@ -0,0 +1,48 @@
+# Chez port — Phase 0 results (jolt-cf1q.1)
+
+De-risk + contract harness. Done; all gates green. Decisions feed Phases 1–3.
+
+## 0a — value model (`host/chez/values.ss`, `test/chez/values-test.ss`)
+Jolt value layer on Chez: nil sentinel (distinct from `#f`/`'()`), interned
+keywords (NUL-separated intern key, no ns/name collision), ns+meta symbols,
+exactness-aware `jolt=` ((= 1 1.0) is false), and a `jolt-hash` consistent with
+it (non-finite-float safe). Chez's numeric tower IS Clojure's — ratios + bignums
+come free. **37/37 tests.**
+
+## 0b — host-neutral contract gate (`test/chez/`)
+The spec corpus is data, so one contract gates every host. Extracted 2655
+`[label expected actual]` cases from `test/spec/*.janet` into `corpus.edn` (valid
+as BOTH EDN and Janet data). `run-corpus.janet` drives ANY jolt binary (pluggable
+`JOLT_BIN`) at the CLI boundary, one fresh subprocess per case. Baseline vs Janet
+`build/jolt` (compile mode, the port's target mode): **2641/2655**, 14 known CLI
+divergences allowlisted (interpret-vs-compile leniency + invoke-collection-as-fn,
+several non-canonical vs JVM anyway). **The gate fails only on NEW divergences** —
+exactly what we want pointed at the Chez host in Phase 1+.
+
+## 0c — persistent-collection perf (`spike/chez/collections-experiment.ss`)
+The shim-vs-self-hosted decision for collections. Map-churn workload from
+`bench/collections.clj` (30000 assoc/get over 4096 keys), correct result (30000):
+
+| | mean | vs Janet | vs native ceiling |
+|---|--:|--:|--:|
+| Janet jolt HAMT | 258.6 ms | 1× | — |
+| Chez persistent HAMT (hand-Scheme) | 6.3 ms (opt3) | **~41×** | ~15× |
+| Chez native hashtable (mutable) | 0.43 ms | ~600× | 1× |
+
+**Decision: self-host the persistent collections in Clojure (jolt-core).** A
+persistent HAMT on the Chez substrate is ~41× faster than Janet's, so the
+substrate is not the bottleneck; a compiled-Clojure HAMT should land near the
+hand-Scheme one (cf. the mandelbrot finding that Chez compiles emitted code to
+the native ceiling). The ~15× gap to mutable-native is the inherent persistence
+cost (node-copy per assoc), identical in kind to JVM Clojure, and closes with
+transients/editable nodes when needed. Keep a Scheme-shim HAMT as fallback ONLY
+if Phase 2 shows the compiled-Clojure version underperforms.
+
+Caveats (spike scope): the experiment uses integer-key-as-hash (shallow,
+collision-free trie) and `merge-leaves` lacks real collision nodes — fine for the
+substrate-speed question; the real RT needs `jolt-hash` + collision handling.
+
+## Net
+Substrate speed (compute + collections), value model, and the parity gate are all
+validated and green. Phase 1 can bootstrap the real pipeline against a known,
+enforceable contract.
diff --git a/host/chez/values.ss b/host/chez/values.ss
index 0e8be9f..19eb0bf 100644
--- a/host/chez/values.ss
+++ b/host/chez/values.ss
@@ -23,7 +23,9 @@
 ;; --- keywords: interned so identity works; optional namespace ----------------
 (define-record-type keyword-t (fields ns name khash) (nongenerative keyword-v1))
 (define keyword-table (make-hashtable string-hash string=?))
-(define (keyword-intern-key ns name) (string-append (or ns "") "/" name))
+;; NUL separator can't occur in a keyword ns/name, so the intern key is
+;; unambiguous (a "/" separator would collide ns="a" name="b/c" with ns="a/b").
+(define (keyword-intern-key ns name) (string-append (or ns "") "\x0;" name))
 (define (keyword ns name)
   (let ((k (keyword-intern-key ns name)))
     (or (hashtable-ref keyword-table k #f)
@@ -67,7 +69,12 @@
     ((jolt-nil? x) 0)
     ((keyword-t? x) (keyword-t-khash x))
     ((symbol-t? x) (equal-hash (cons (symbol-t-ns x) (symbol-t-name x))))
-    ((number? x) (if (exact? x) (equal-hash x) (equal-hash (cons 'inexact (inexact->exact x)))))
+    ;; distinguish inexact from exact (1 and 1.0 are not jolt=); guard non-finite
+    ;; (inexact->exact would error on NaN/inf)
+    ((number? x) (if (exact? x) (equal-hash x)
+                     (if (and (flonum? x) (or (nan? x) (infinite? x)))
+                         (equal-hash (cons 'inexact (number->string x)))
+                         (equal-hash (cons 'inexact (inexact->exact x))))))
     ((string? x) (string-hash x))
     ((char? x) (char->integer x))
     ((boolean? x) (if x 1 2))
diff --git a/spike/chez/collections-experiment.ss b/spike/chez/collections-experiment.ss
new file mode 100644
index 0000000..00eb268
--- /dev/null
+++ b/spike/chez/collections-experiment.ss
@@ -0,0 +1,119 @@
+;; Phase 0c — persistent-collection perf experiment.
+;;
+;; Decides shim-vs-self-hosted for collections: is a persistent HAMT fast enough
+;; on the Chez substrate that we can afford to SELF-HOST it (in Clojure compiled
+;; by Chez) rather than keep it in the Scheme shim? This measures the substrate
+;; ceiling with a hand-written Scheme HAMT (what the backend would emit) against
+;; Chez's native mutable hashtable (the non-persistent lower bound), on the
+;; collections-bench map workload (freq-map + sum-vals, n keys mod 4096).
+;;   chez --script collections-experiment.ss [n=30000] [optlevel=2]
+(import (chezscheme))
+(optimize-level
+  (let ((a (command-line-arguments)))
+    (if (and (pair? a) (pair? (cdr a))) (string->number (cadr a)) 2)))
+
+;; ---- persistent bitmap HAMT (assoc/get), 5 bits/level, integer-key hash ------
+(define-record-type hnode (fields bitmap arr) (nongenerative hnode-v1))
+(define empty-map (make-hnode 0 (vector)))
+
+(define (popcount n)
+  (let loop ((n n) (c 0)) (if (fx=? n 0) c (loop (fxand n (fx- n 1)) (fx+ c 1)))))
+(define (mask h shift) (fxand (fxsra h shift) 31))
+(define (idxof bitmap bit) (popcount (fxand bitmap (fx- bit 1))))
+
+(define (vec-insert v i x)
+  (let* ((n (vector-length v)) (out (make-vector (fx+ n 1))))
+    (let loop ((j 0))
+      (when (fx<? j i) (vector-set! out j (vector-ref v j)) (loop (fx+ j 1))))
+    (vector-set! out i x)
+    (let loop ((j i)) (when (fx<? j n) (vector-set! out (fx+ j 1) (vector-ref v j)) (loop (fx+ j 1))))
+    out))
+(define (vec-set v i x)
+  (let ((out (vector-copy v))) (vector-set! out i x) out))
+
+;; leaf = (cons key val); subtree = hnode
+(define (merge-leaves shift k1h e1 k2h k2 v2)
+  (if (fx>? shift 30)
+      ;; hash exhausted (won't happen for distinct small ints) — chain via assoc-list leaf
+      (cons 'collision (list e1 (cons k2 v2)))
+      (let ((i1 (mask k1h shift)) (i2 (mask k2h shift)))
+        (if (fx=? i1 i2)
+            (let ((sub (merge-leaves (fx+ shift 5) k1h e1 k2h k2 v2)))
+              (make-hnode (fxsll 1 i1) (vector sub)))
+            (let* ((b1 (fxsll 1 i1)) (b2 (fxsll 1 i2)))
+              (if (fx<? i1 i2)
+                  (make-hnode (fxior b1 b2) (vector e1 (cons k2 v2)))
+                  (make-hnode (fxior b1 b2) (vector (cons k2 v2) e1))))))))
+
+(define (assoc-h node shift h key val)
+  (let* ((bit (fxsll 1 (mask h shift)))
+         (bm (hnode-bitmap node))
+         (arr (hnode-arr node)))
+    (if (fx=? 0 (fxand bm bit))
+        (make-hnode (fxior bm bit) (vec-insert arr (idxof bm bit) (cons key val)))
+        (let* ((i (idxof bm bit)) (child (vector-ref arr i)))
+          (cond
+            ((hnode? child)
+             (make-hnode bm (vec-set arr i (assoc-h child (fx+ shift 5) h key val))))
+            ((eqv? (car child) key)              ; leaf, same key -> replace
+             (make-hnode bm (vec-set arr i (cons key val))))
+            (else                                ; leaf, diff key -> split
+             (make-hnode bm (vec-set arr i (merge-leaves (fx+ shift 5)
+                                              (car child) child h key val)))))))))
+(define (assoc-map m key val) (assoc-h m 0 key key val))   ; hash = key (distinct small ints)
+
+(define (get-h node shift h key default)
+  (let* ((bit (fxsll 1 (mask h shift))) (bm (hnode-bitmap node)))
+    (if (fx=? 0 (fxand bm bit)) default
+        (let ((child (vector-ref (hnode-arr node) (idxof bm bit))))
+          (cond ((hnode? child) (get-h child (fx+ shift 5) h key default))
+                ((eqv? (car child) key) (cdr child))
+                (else default))))))
+(define (get-map m key default) (get-h m 0 key key default))
+
+;; ---- workloads (mirror bench/collections.clj freq-map + sum-vals) ------------
+(define buckets 4096)
+(define (freq-hamt n)
+  (let loop ((i 0) (m empty-map))
+    (if (fx<? i n)
+        (let ((k (fxmod (fx* i 2654435761) buckets)))
+          (loop (fx+ i 1) (assoc-map m k (fx+ 1 (get-map m k 0)))))
+        m)))
+(define (freq-native n)
+  (let ((m (make-eqv-hashtable)))
+    (let loop ((i 0))
+      (if (fx<? i n)
+          (let ((k (fxmod (fx* i 2654435761) buckets)))
+            (hashtable-set! m k (fx+ 1 (hashtable-ref m k 0)))
+            (loop (fx+ i 1)))
+          m))))
+;; sum back: HAMT walk vs native walk
+(define (sum-hamt m)
+  (let walk ((node m) (acc 0))
+    (let ((arr (hnode-arr node)))
+      (let loop ((j 0) (acc acc))
+        (if (fx<? j (vector-length arr))
+            (let ((c (vector-ref arr j)))
+              (loop (fx+ j 1) (if (hnode? c) (walk c acc) (fx+ acc (cdr c)))))
+            acc)))))
+(define (sum-native m) (call-with-values (lambda () (hashtable-entries m))
+                         (lambda (ks vs) (let ((acc 0)) (vector-for-each (lambda (v) (set! acc (fx+ acc v))) vs) acc))))
+
+;; ---- bench harness -----------------------------------------------------------
+(define (now-ns) (let ((t (current-time 'time-monotonic)))
+                   (+ (* (time-second t) 1000000000) (time-nanosecond t))))
+(define (bench name build sum n)
+  (sum (build (quotient n 4))) (sum (build (quotient n 4)))         ; warmup
+  (let loop ((k 0) (acc '()) (r 0))
+    (if (fx<? k 3)
+        (let* ((t0 (now-ns)) (m (build n)) (s (sum m))
+               (ms (/ (- (now-ns) t0) 1000000.0)))
+          (loop (fx+ k 1) (cons ms acc) s))
+        (printf "~a  result ~a  mean ~a ms\n" name r
+                (exact->inexact (/ (apply + acc) 3.0))))))
+
+(let* ((a (command-line-arguments))
+       (n (if (pair? a) (string->number (car a)) 30000)))
+  (printf "collections map-churn (n=~a, ~a buckets)\n" n buckets)
+  (bench "persistent HAMT (self-hostable) " freq-hamt   sum-hamt   n)
+  (bench "native hashtable (mutable, ceil)" freq-native sum-native n))
diff --git a/test/chez/values-test.ss b/test/chez/values-test.ss
index 3ecdba9..cb8ecb0 100644
--- a/test/chez/values-test.ss
+++ b/test/chez/values-test.ss
@@ -56,5 +56,12 @@
 (ok "hash 1 != 1.0"     (not (= (jolt-hash 1) (jolt-hash 1.0))))
 (ok "hash str stable"   (= (jolt-hash "abc") (jolt-hash "abc")))
 
+;; regression: keyword intern key must not collide across ns/name boundary
+(ok "kw no boundary collide" (not (eq? (keyword "a" "b/c") (keyword "a/b" "c"))))
+;; regression: jolt-hash must not throw on non-finite floats
+(ok "hash +inf ok" (number? (jolt-hash +inf.0)))
+(ok "hash +nan ok"  (number? (jolt-hash +nan.0)))
+(ok "hash inf != exact" (not (= (jolt-hash +inf.0) (jolt-hash 0))))
+
 (printf "values-test: ~a/~a passed\n" (- total fails) total)
 (exit (if (> fails 0) 1 0))