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

Chez Phase 0c + 0a hardening: collections decision + value-model fixes

Browse source 
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.
This commit is contained in:
Yogthos 2026-06-17 13:10:19 -04:00
parent c9316dd372
commit b3d0a91e3e
4 changed files with 183 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

48
docs/chez-phase0-results.md Normal file
View file

@ -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.

11
host/chez/values.ss
View file

@ -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))

119
spike/chez/collections-experiment.ss Normal file
View file

@ -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))

7
test/chez/values-test.ss
View file

@ -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))