From 18737360459a2a28a9e0708e08146cef90b94ab3 Mon Sep 17 00:00:00 2001 From: Dmitri Sotnikov Date: Tue, 16 Jun 2026 22:24:38 +0000 Subject: [PATCH] phm/phs: bulk bottom-up HAMT build for the map/set builders (jolt-5vsp) (#154) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit into {}, frequencies, group-by, set, into #{} and persistent! all built their result by folding an immutable assoc/conj per element — each call rebuilt the O(log32 n) trie path and allocated a fresh wrapper. Add a one-pass bottom-up HAMT builder (phm-from-pairs) and route the builders through it, the map/set analog of the pvec bulk build in #153. phm-from-pairs partitions entries by hash and constructs the bin/array/ collision nodes directly, with the same bin<=16 / array-node>=17 promotion the incremental path uses — so the trie is byte-identical to one built by phm-assoc (validated across the size and branching boundaries, including hash collisions, duplicate keys and the nil key). persistent! map/set and the set constructor bulk-build; into {} keeps the small-scalar-map-stays-a -struct rule via bulk-map-from-pairs; frequencies/group-by switch to the canonical transient form and ride the fast persistent!. 50k A/B: into {} 704->270ms, frequencies 582->160, set 615->241, into #{} 702->240, group-by 1358->919 (bound on persistent vector conj). Gate: conformance x3, full suite (4718 >= baseline), new maps/sets bulk boundary specs. Co-authored-by: Yogthos --- jolt-core/clojure/core/20-coll.clj | 15 +++--- src/jolt/core_coll.janet | 44 +++++++++++++++- src/jolt/core_extra.janet | 8 ++- src/jolt/phm.janet | 83 ++++++++++++++++++++++++++++-- src/jolt/phs.janet | 14 +++-- test/spec/maps-spec.janet | 21 ++++++++ test/spec/sets-spec.janet | 15 ++++++ 7 files changed, 182 insertions(+), 18 deletions(-) diff --git a/jolt-core/clojure/core/20-coll.clj b/jolt-core/clojure/core/20-coll.clj index 95bb17d..829b2aa 100644 --- a/jolt-core/clojure/core/20-coll.clj +++ b/jolt-core/clojure/core/20-coll.clj @@ -64,15 +64,18 @@ (defn println [& xs] (apply print xs) (__write "\n") nil) -;; Base is (hash-map), not the {} literal: a literal map is a struct that doesn't -;; canonicalize collection keys across representations (a {:a 1} literal vs -;; (hash-map :a 1) key), whereas a PHM does — so counting/grouping by collection -;; value needs the PHM base (the prior Janet impl used make-phm for this reason). +;; Transient accumulation (canonical JVM form): assoc! into a native-backed +;; scratch table per element, then persistent! bulk-builds the HAMT once — +;; instead of a fresh persistent assoc (full trie-path rebuild) per element. +;; A transient map canonicalizes collection keys (it is canon-keyed, like a +;; PHM), so counting/grouping by collection value still works across map reps. (defn frequencies [coll] - (reduce (fn [counts x] (assoc counts x (inc (get counts x 0)))) (hash-map) coll)) + (persistent! + (reduce (fn [counts x] (assoc! counts x (inc (get counts x 0)))) (transient {}) coll))) (defn group-by [f coll] - (reduce (fn [ret x] (let [k (f x)] (assoc ret k (conj (get ret k []) x)))) (hash-map) coll)) + (persistent! + (reduce (fn [ret x] (let [k (f x)] (assoc! ret k (conj (get ret k []) x)))) (transient {}) coll))) (defn not-empty [coll] (if (or (nil? coll) (zero? (count coll))) nil coll)) diff --git a/src/jolt/core_coll.janet b/src/jolt/core_coll.janet index 15f3f03..8d945a5 100644 --- a/src/jolt/core_coll.janet +++ b/src/jolt/core_coll.janet @@ -421,9 +421,43 @@ (string? coll) (make-vec (map |(string/from-bytes $) (string/bytes coll))) (make-vec @[])))) +# Bulk-build a map value from a native array of [k v] pairs, mirroring +# core-assoc's struct-vs-phm choice: stay a small Janet struct (the +# PersistentArrayMap analog) when every key is a scalar, there is no nil key or +# value, and the distinct count is within the threshold; otherwise bulk-build +# the HAMT once (phm-from-pairs). Used by into-a-struct-map (jolt-5vsp). +(defn- bulk-map-from-pairs [pairs] + (var promote false) + (def t @{}) + (each p pairs + (def k (vnth p 0)) (def v (vnth p 1)) + (if (or (table? k) (array? k) (nil? k) (nil? v)) + (set promote true) + (put t k v))) # scalar keys: last-wins + (if (or promote (> (length t) map-array-threshold)) + (phm-from-pairs pairs) + (table/to-struct t))) + (defn- into-conj [to items] (cond - (or (phm? to) (struct? to) (and (table? to) (get to :jolt/deftype))) + # into onto an existing phm stays a phm: accumulate its entries + the new + # [k v] items and bulk-build the HAMT ONCE (phm-from-pairs, last-value-wins), + # instead of a phm-assoc per element. jolt-5vsp collections. + (phm? to) + (let [acc (array)] + (each e (phm-entries to) (array/push acc e)) + (each item items (array/push acc [(vnth item 0) (vnth item 1)])) + (phm-from-pairs acc)) + # into onto a plain map struct (e.g. the {} literal): same one-pass build, + # but keep the small-scalar-map-stays-a-struct rule (bulk-map-from-pairs) so + # the representation matches the incremental assoc-onto-a-struct path. + (and (struct? to) (nil? (get to :jolt/type))) + (let [acc (array)] + (each e (pairs to) (array/push acc e)) + (each item items (array/push acc [(vnth item 0) (vnth item 1)])) + (bulk-map-from-pairs acc)) + # Other map-likes (sorted maps, deftype records): fold core-assoc. + (or (struct? to) (and (table? to) (get to :jolt/deftype))) (do (var result to) (each item items (set result (core-assoc result (vnth item 0) (vnth item 1)))) result) @@ -437,7 +471,13 @@ (do (each x items (array/push to x)) to) # vector: append (do (var result (array/slice to)) (each x items (array/insert result 0 x)) result)) # list: prepend (tuple? to) (tuple/slice (tuple ;(array/concat (array/slice to) (array/slice items)))) - # everything else conj-able (sets, sorted colls): fold conj — previously + # hash-set target: accumulate existing members + new items and bulk-build the + # backing HAMT ONCE (phs-from-seq), instead of a phs-conj per element. + (set? to) (let [acc (array)] + (each x (phs-seq to) (array/push acc x)) + (each x items (array/push acc x)) + (phs-from-seq acc)) + # everything else conj-able (sorted colls): fold conj — previously # this fell through to `to` unchanged, silently dropping all elements # ((into #{} [:a :b]) was #{}, jolt-h86) (do (var result to) (each x items (set result (core-conj result x))) result))) diff --git a/src/jolt/core_extra.janet b/src/jolt/core_extra.janet index e6f1eb1..6a44bb0 100644 --- a/src/jolt/core_extra.janet +++ b/src/jolt/core_extra.janet @@ -427,8 +427,12 @@ (def result (case (t :kind) :vector (make-vec (t :arr)) - :set (do (var s (make-phs)) (each [_ e] (pairs (t :tbl)) (set s (phs-conj s e))) s) - :map (do (var m (make-phm)) (each [_ pair] (pairs (t :tbl)) (set m (phm-assoc m (in pair 0) (in pair 1)))) m))) + # The transient already deduped into a native table; bulk-build the + # persistent value ONCE (bottom-up HAMT) instead of folding a phm-assoc + # per entry. This is the lever behind every transient-based builder + # (frequencies/group-by/set/into) — jolt-5vsp collections. + :set (phs-from-seq (values (t :tbl))) + :map (phm-from-pairs (values (t :tbl))))) # Invalidate: any further bang op (or a second persistent!) now throws. (put t :jolt/persistent true) result) diff --git a/src/jolt/phm.janet b/src/jolt/phm.janet index e10ec70..7a6f297 100644 --- a/src/jolt/phm.janet +++ b/src/jolt/phm.janet @@ -297,10 +297,83 @@ (defn phm-count [m] (m :cnt)) +# --- bulk bottom-up build (jolt-5vsp collections) --------------------------- +# Build the HAMT in one pass from a native array of entries, instead of n +# incremental phm-assoc calls (each of which rebuilt the O(log32 n) path with +# fresh arrays AND allocated a fresh map wrapper). The structure produced is +# IDENTICAL to the incremental one: the trie shape is a function of the key set +# (hash-partitioned, with the same bin<=16 / array-node>=17 promotion threshold +# at each level), so nth/lookup/assoc/without/each read it unchanged. Only a +# hash-collision node's internal order is insertion-dependent, and we preserve +# insertion order there too. Validated against phm-assoc across the size and +# branching boundaries (see the throwaway script in the PR). +# +# Entries are @[h key val] triples (h = khash key). build-node takes a non-empty +# group all destined for the same parent slot and returns its node. +(defn- all-same-hash? [entries] + (def h0 (in (in entries 0) 0)) + (var same true) (var i 1) (def L (length entries)) + (while (< i L) (when (not= (in (in entries i) 0) h0) (set same false) (break)) (++ i)) + same) + +(defn- build-node [entries shift] + (if (and (> (length entries) 1) (all-same-hash? entries)) + # all keys share a full 32-bit hash -> collision node (insertion order) + (let [arr (array)] + (each e entries (array/push arr (in e 1)) (array/push arr (in e 2))) + [:hcn (in (in entries 0) 0) (length entries) arr]) + # partition by the 5-bit mask at this level; iterate slots 0..31 ascending + # so the bin arr / array-node slots land in canonical (bidx) order. + (let [groups @{}] + (each e entries + (def m (mask (in e 0) shift)) + (if-let [g (in groups m)] (array/push g e) (put groups m @[e]))) + (def occupied (array)) + (var i 0) (while (< i 32) (when (in groups i) (array/push occupied i)) (++ i)) + (def s (length occupied)) + (if (>= s 17) + # array-node: every occupied slot is a sub-node (a lone key becomes its + # own single-key bin node at shift+5, matching the expand path). + (let [slots (array/new-filled 32 nil)] + (each m occupied (put slots m (build-node (in groups m) (+ shift 5)))) + [:an s slots]) + # bitmap-indexed node: lone key -> leaf pair, group -> nil + sub-node. + (let [arr (array)] + (var bitmap 0) + (each m occupied + (def g (in groups m)) + (set bitmap (bor bitmap (blshift 1 m))) + (if (= 1 (length g)) + (do (array/push arr (in (in g 0) 1)) (array/push arr (in (in g 0) 2))) + (do (array/push arr nil) (array/push arr (build-node g (+ shift 5)))))) + [:bin bitmap arr]))))) + +(defn phm-from-pairs [pairs &opt meta] + "Bulk-build a phm from an indexed collection of native [k v] pairs. Duplicate + keys follow assoc semantics (last value wins, first-seen key object kept). The + caller must pass native tuples/arrays (phm stays free of the value layer)." + (default meta nil) + (def entries @[]) + (def seen @{}) # canon-key -> index into entries (dedup) + (var has-nil false) (var nil-val nil) + (each p pairs + (def k (in p 0)) (def v (in p 1)) + (if (nil? k) + (do (set has-nil true) (set nil-val v)) + (let [c (ck k)] + (if-let [idx (in seen c)] + (put (in entries idx) 2 v) # last value wins + (do (put seen c (length entries)) + (array/push entries @[(khash k) k v])))))) + (def cnt (+ (length entries) (if has-nil 1 0))) + (def root (if (= 0 (length entries)) nil (build-node entries 0))) + (mk cnt root has-nil nil-val meta)) + (defn make-phm [&opt kvs] (default kvs nil) - (var m (mk 0 nil false nil nil)) - (when kvs - (var i 0) (def n (length kvs)) - (while (< i n) (set m (phm-assoc m (kvs i) (kvs (+ i 1)))) (+= i 2))) - m) + (if (or (nil? kvs) (= 0 (length kvs))) + (mk 0 nil false nil nil) + # pair up the flat [k0 v0 k1 v1 ...] array and bulk-build + (let [pairs (array) n (length kvs)] + (var i 0) (while (< i n) (array/push pairs [(in kvs i) (in kvs (+ i 1))]) (+= i 2)) + (phm-from-pairs pairs)))) diff --git a/src/jolt/phs.janet b/src/jolt/phs.janet index 536ba50..fe026e6 100644 --- a/src/jolt/phs.janet +++ b/src/jolt/phs.janet @@ -14,11 +14,19 @@ [x] (and (table? x) (= :jolt/set (x :jolt/type)))) +(defn phs-from-seq [xs] + "Bulk-build a PersistentHashSet from an indexed collection of members. Members + back a phm as keys mapped to true, so the bulk HAMT builder (phm-from-pairs, + which dedups by canonical key) gives set semantics in one pass instead of an + immutable phm-assoc per element." + (def pairs @[]) + (each x xs (array/push pairs [x true])) + (def m (phm-from-pairs pairs)) + @{:jolt/type :jolt/set :phm m :cnt (phm-count m)}) + (defn make-phs [& xs] "Create a PersistentHashSet from items." - (var m (make-phm)) - (each x xs (set m (phm-assoc m x true))) - @{:jolt/type :jolt/set :phm m :cnt (phm-count m)}) + (phs-from-seq xs)) (defn phs-conj [s & xs] (var m (s :phm)) diff --git a/test/spec/maps-spec.janet b/test/spec/maps-spec.janet index 14fc6cc..2656453 100644 --- a/test/spec/maps-spec.janet +++ b/test/spec/maps-spec.janet @@ -187,3 +187,24 @@ ["assoc-in deep get" "9" "(get-in (assoc-in {} [:a :b :c] 9) [:a :b :c])"] ["seq over assoc-nil map" ":a" "(ffirst (seq (assoc nil :a 1)))"] ["keys of assoc-nil map" "[:a]" "(vec (keys (assoc nil :a 1)))"]) + +# into {} / frequencies / group-by bulk-build the HAMT in one pass from a native +# pairs/table accumulator (phm-from-pairs), instead of an assoc per element +# (jolt-5vsp collections). Cross the bin(<=16)/array-node(>=17) promotion and a +# size that grows the trie a level; check dedup (last-wins), nil keys, and that +# assoc/dissoc after a bulk build still land. The structure is identical to the +# incremental builder (validated in the PR), so reads agree. +(defspec "map / bulk build boundaries" + ["into = incr at 17" "true" "(= (into {} (map (fn [i] [i (* i 2)]) (range 17))) (reduce (fn [m p] (assoc m (first p) (second p))) {} (map (fn [i] [i (* i 2)]) (range 17))))"] + ["into = incr at 1000" "true" "(= (into {} (map (fn [i] [i (* i 2)]) (range 1000))) (reduce (fn [m p] (assoc m (first p) (second p))) {} (map (fn [i] [i (* i 2)]) (range 1000))))"] + ["into count 1000" "1000" "(count (into {} (map (fn [i] [i i]) (range 1000))))"] + ["into reads back" "999" "(get (into {} (map (fn [i] [i (* i 3)]) (range 1000))) 333)"] + ["into onto non-empty" "9" "(get (into {:a 1} [[:a 9] [:b 2]]) :a)"] + ["into dup last wins" "9" "(get (into {} [[:k 1] [:k 9]]) :k)"] + ["into nil key" ":x" "(get (into {} [[nil :x] [:a 1]]) nil)"] + ["assoc after bulk" "7" "(get (assoc (into {} (map (fn [i] [i i]) (range 100))) :new 7) :new)"] + ["dissoc after bulk" "nil" "(get (dissoc (into {} (map (fn [i] [i i]) (range 100))) 50) 50)"] + ["frequencies count" "3" "(get (frequencies [1 2 2 1 2 1]) 1)"] + ["frequencies coll-key" "2" "(get (frequencies [[1 2] [1 2] [3 4]]) [1 2])"] + ["group-by bucket" "[1 3 5]" "(get (group-by odd? (range 1 6)) true)"] + ["hash-map bulk = incr" "true" "(= (apply hash-map (mapcat (fn [i] [i i]) (range 50))) (reduce (fn [m i] (assoc m i i)) {} (range 50)))"]) diff --git a/test/spec/sets-spec.janet b/test/spec/sets-spec.janet index cc99124..5ba1eee 100644 --- a/test/spec/sets-spec.janet +++ b/test/spec/sets-spec.janet @@ -56,3 +56,18 @@ ["vector is not" "false" "(set? [1])"] ["coll? still true" "true" "(coll? (sorted-set 1))"] ["ifn? sorted-set" "true" "(ifn? (sorted-set 1))"]) + +# set / into #{} bulk-build the backing HAMT in one pass (phs-from-seq), instead +# of a phs-conj per element (jolt-5vsp collections). Cross the promotion +# boundary, check dedup, collection members, and conj after a bulk build. +(defspec "set / bulk build boundaries" + ["set dedup count" "3" "(count (set [1 1 2 3 3 2]))"] + ["set big count" "1000" "(count (set (range 1000)))"] + ["into #{} count" "500" "(count (into #{} (range 500)))"] + ["into #{} onto base" "3" "(count (into #{:a} [:a :b :c]))"] + ["set contains" "true" "(contains? (set (range 1000)) 777)"] + ["set missing" "false" "(contains? (set (range 1000)) 5000)"] + ["set coll members" "true" "(contains? (set [[1 2] [3 4]]) [1 2])"] + ["conj after bulk" "true" "(contains? (conj (set (range 100)) :x) :x)"] + ["disj after bulk" "false" "(contains? (disj (set (range 100)) 50) 50)"] + ["set = literal" "true" "(= #{0 1 2} (set (range 3)))"])