phm: grow the bucket array past load factor 2 (map-read 4.5x recovery)

The phm had a FIXED 8 buckets, so a 100-entry map was a ~12-entry linear
scan per lookup — and phm-get walked the bucket twice (contains? then find).
This went mostly unnoticed until the canonical zipmap (batch 2) started
returning phms where kvs->map had built structs for scalar keys, regressing
the map-read bench ~7x (jolt-s3y).

phm-assoc now rehashes into a doubled bucket array when the count passes 2
entries/bucket (done on the fresh copy, so persistence is untouched);
phm-get is single-pass with a presence flag (nil values still distinguish
from missing); key= tries identity/scalar equality before paying for
canonicalization; the bucket count is derived from (length (m :buckets)),
not a constant, so any already-marshaled map keeps working. core-contains?'s
phm branch goes through phm-contains? instead of poking buckets directly.

map-read 48.5 -> 10.9 ms (the residual vs the pre-batch-2 6.7 is the
canonicalizing-representation constant); map-build steady; bench TOTAL 4457
vs 4565 on main back-to-back. New unit case crosses the resize boundary at
500 entries: every key found, nil values present, collection keys canonical,
dissoc + persistence intact. Gate: jpm exit 0, conformance 326x3.
This commit is contained in:
Yogthos 2026-06-10 17:06:03 -04:00
parent 1d373299a4
commit 24a8522b51
3 changed files with 76 additions and 24 deletions

View file

@ -625,7 +625,7 @@
:vector (and (number? key) (>= key 0) (< key (length (coll :arr)))) :vector (and (number? key) (>= key 0) (< key (length (coll :arr))))
(not (nil? (get (coll :tbl) (canon-key key))))) (not (nil? (get (coll :tbl) (canon-key key)))))
(if (set? coll) (phs-contains? coll key) (if (set? coll) (phs-contains? coll key)
(if (phm? coll) (let [b (get (coll :buckets) (phm-hash-key key))] (if b (phm-bucket-contains? b key) false)) (if (phm? coll) (phm-contains? coll key)
(if (pvec? coll) (and (number? key) (>= key 0) (< key (pv-count coll))) (if (pvec? coll) (and (number? key) (>= key 0) (< key (pv-count coll)))
(if (struct? coll) (not (nil? (coll key))) (if (struct? coll) (not (nil? (coll key)))
(if (table? coll) (not (nil? (coll key))) (if (table? coll) (not (nil? (coll key)))

View file

@ -1,7 +1,12 @@
# PersistentHashMap implementation for Jolt # PersistentHashMap implementation for Jolt
# Bucket-based hash map with copy-on-write semantics. # Bucket-based hash map with copy-on-write semantics. The bucket array GROWS
# (doubling, rehash) when the load factor passes 2 entries/bucket, so lookups
# stay O(1)-ish at any size — with a fixed 8 buckets, a 100-entry map was a
# ~12-entry linear scan per get (the jolt-s3y map-read regression). The bucket
# count is derived from (length (m :buckets)), so marshaled images from before
# this change keep working.
(def- bucket-count 8) (def- initial-buckets 8)
(defn phm? [x] (defn phm? [x]
(and (table? x) (and (table? x)
@ -27,10 +32,12 @@
scalars). Used by callers that index the same canonicalized tables phm uses scalars). Used by callers that index the same canonicalized tables phm uses
(e.g. transient maps/sets)." (e.g. transient maps/sets)."
[k] (ck k)) [k] (ck k))
(defn- key= [a b] (= (ck a) (ck b))) # Identity/scalar equality first — the common case — before paying for
# canonicalization of collection keys.
(defn- key= [a b] (or (= a b) (= (ck a) (ck b))))
(defn phm-hash-key [k] (defn- hash-idx [m k]
(if (nil? k) 0 (mod (hash (ck k)) bucket-count))) (if (nil? k) 0 (mod (hash (ck k)) (length (m :buckets)))))
(defn- phm-bucket-find [bucket k] (defn- phm-bucket-find [bucket k]
(var i 0) (var n (length bucket)) (var found nil) (var i 0) (var n (length bucket)) (var found nil)
@ -71,42 +78,70 @@
(defn phm-get [m k &opt default] (defn phm-get [m k &opt default]
(default default nil) (default default nil)
(let [bucket (get (m :buckets) (phm-hash-key k))] (let [bucket (get (m :buckets) (hash-idx m k))]
# presence-check, not nil-of-value: a key mapped to nil is still present, # Single pass with a presence flag (not nil-of-value): a key mapped to nil
# so return nil (not the default) when the key exists with a nil value. # is still present, so return nil (not the default) when it exists.
(if (and bucket (phm-bucket-contains? bucket k)) (if bucket
(phm-bucket-find bucket k) (do
(var i 0) (var n (length bucket)) (var result default)
(while (< i n)
(if (key= k (in bucket i)) (do (set result (in bucket (+ i 1))) (break)))
(+= i 2))
result)
default))) default)))
# Rehash every entry of `buckets` into a fresh array of `nb` buckets.
(defn- rehash [buckets nb]
(def out (array/new-filled nb nil))
(each bucket buckets
(when bucket
(var i 0) (var n (length bucket))
(while (< i n)
(let [k (in bucket i)
idx (if (nil? k) 0 (mod (hash (ck k)) nb))]
(when (nil? (in out idx)) (put out idx @[]))
(array/push (in out idx) k)
(array/push (in out idx) (in bucket (+ i 1))))
(+= i 2))))
out)
(defn phm-assoc [m k v] (defn phm-assoc [m k v]
(let [cnt (m :cnt) idx (phm-hash-key k) (let [cnt (m :cnt) idx (hash-idx m k)
old-bucket (get (m :buckets) idx) old-bucket (get (m :buckets) idx)
had-key (if old-bucket (phm-bucket-contains? old-bucket k) false) had-key (if old-bucket (phm-bucket-contains? old-bucket k) false)
new-bucket (phm-bucket-assoc (if old-bucket old-bucket @[]) k v) new-bucket (phm-bucket-assoc (if old-bucket old-bucket @[]) k v)
new-cnt (if had-key cnt (+ cnt 1)) new-cnt (if had-key cnt (+ cnt 1))
new-buckets (array/new bucket-count)] nbuckets (length (m :buckets))
new-buckets (array/new nbuckets)]
(var bi 0) (var bi 0)
(while (< bi bucket-count) (while (< bi nbuckets)
(put new-buckets bi (if (= bi idx) new-bucket (get (m :buckets) bi))) (++ bi)) (put new-buckets bi (if (= bi idx) new-bucket (get (m :buckets) bi))) (++ bi))
# Grow past load factor 2 (doubling) so buckets stay short. Done on the
# copy, so persistence is untouched.
(def grown (if (> new-cnt (* 2 nbuckets))
(rehash new-buckets (* 2 nbuckets))
new-buckets))
@{:jolt/deftype "jolt.lang.persistent-hash-map.PersistentHashMap" @{:jolt/deftype "jolt.lang.persistent-hash-map.PersistentHashMap"
:cnt new-cnt :buckets new-buckets :_meta (m :_meta)})) :cnt new-cnt :buckets grown :_meta (m :_meta)}))
(defn phm-dissoc [m k] (defn phm-dissoc [m k]
(let [idx (phm-hash-key k) old-bucket (get (m :buckets) idx)] (let [idx (hash-idx m k) old-bucket (get (m :buckets) idx)]
(if old-bucket (if old-bucket
(let [new-bucket (phm-bucket-dissoc old-bucket k)] (let [new-bucket (phm-bucket-dissoc old-bucket k)]
(if (= new-bucket old-bucket) m (if (= new-bucket old-bucket) m
(let [new-cnt (- (m :cnt) 1) new-buckets (array/new bucket-count)] (let [new-cnt (- (m :cnt) 1)
nbuckets (length (m :buckets))
new-buckets (array/new nbuckets)]
(var bi 0) (var bi 0)
(while (< bi bucket-count) (while (< bi nbuckets)
(put new-buckets bi (if (= bi idx) new-bucket (get (m :buckets) bi))) (++ bi)) (put new-buckets bi (if (= bi idx) new-bucket (get (m :buckets) bi))) (++ bi))
@{:jolt/deftype "jolt.lang.persistent-hash-map.PersistentHashMap" @{:jolt/deftype "jolt.lang.persistent-hash-map.PersistentHashMap"
:cnt new-cnt :buckets new-buckets :_meta (m :_meta)}))) :cnt new-cnt :buckets new-buckets :_meta (m :_meta)})))
m))) m)))
(defn phm-entries [m] (defn phm-entries [m]
(var result @[]) (var bi 0) (var result @[]) (var bi 0) (def nb (length (m :buckets)))
(while (< bi bucket-count) (while (< bi nb)
(let [bucket (get (m :buckets) bi)] (let [bucket (get (m :buckets) bi)]
(when bucket (when bucket
(var i 0) (var n (length bucket)) (var i 0) (var n (length bucket))
@ -115,8 +150,8 @@
result) result)
(defn phm-to-struct [m] (defn phm-to-struct [m]
(var result @{}) (var bi 0) (var result @{}) (var bi 0) (def nb (length (m :buckets)))
(while (< bi bucket-count) (while (< bi nb)
(let [bucket (get (m :buckets) bi)] (let [bucket (get (m :buckets) bi)]
(when bucket (when bucket
(var i 0) (var n (length bucket)) (var i 0) (var n (length bucket))
@ -127,13 +162,13 @@
(defn phm-count [m] (m :cnt)) (defn phm-count [m] (m :cnt))
(defn phm-contains? [m k] (defn phm-contains? [m k]
(let [bucket (get (m :buckets) (phm-hash-key k))] (let [bucket (get (m :buckets) (hash-idx m k))]
(if bucket (phm-bucket-contains? bucket k) false))) (if bucket (phm-bucket-contains? bucket k) false)))
(defn make-phm [&opt kvs] (defn make-phm [&opt kvs]
(default kvs nil) (default kvs nil)
(var m @{:jolt/deftype "jolt.lang.persistent-hash-map.PersistentHashMap" (var m @{:jolt/deftype "jolt.lang.persistent-hash-map.PersistentHashMap"
:cnt 0 :buckets (array/new bucket-count) :_meta nil}) :cnt 0 :buckets (array/new-filled initial-buckets nil) :_meta nil})
(when kvs (when kvs
(var i 0) (var n (length kvs)) (var i 0) (var n (length kvs))
(while (< i n) (set m (phm-assoc m (kvs i) (kvs (+ i 1)))) (+= i 2))) (while (< i n) (set m (phm-assoc m (kvs i) (kvs (+ i 1)))) (+= i 2)))

View file

@ -72,4 +72,21 @@
(assert (= 42 (ct-eval ctx "(get big-map :k42)")) "get k42")) (assert (= 42 (ct-eval ctx "(get big-map :k42)")) "get k42"))
(print " passed") (print " passed")
(print "6: bucket resize (jolt-s3y)...")
(let [ctx (init-cached)]
# Crossing the load-factor boundary several times: every key still found,
# nil values preserved, collection keys still canonical, dissoc intact.
(eval-string ctx "
(def m (reduce (fn [m i] (assoc m i (* 10 i))) (hash-map) (range 500)))")
(assert (= 500 (ct-eval ctx "(count m)")) "count survives rehash")
(assert (= true (ct-eval ctx "(every? (fn [i] (= (* 10 i) (get m i))) (range 500))"))
"every key found after rehash")
(assert (= true (ct-eval ctx "(let [m2 (assoc m :nilv nil)] (and (contains? m2 :nilv) (nil? (get m2 :nilv :miss))))"))
"nil value present after rehash")
(assert (= :hit (ct-eval ctx "(get (assoc m [1 2] :hit) [1 2])"))
"collection key canonical after rehash")
(assert (= 499 (ct-eval ctx "(count (dissoc m 0))")) "dissoc after rehash")
(assert (= 500 (ct-eval ctx "(count m)")) "persistence: source unchanged"))
(print " passed")
(print "\nAll PersistentHashMap tests passed!") (print "\nAll PersistentHashMap tests passed!")