phm/phs: bulk bottom-up HAMT build for the map/set builders (jolt-5vsp) (#154)

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 <yogthos@gmail.com>

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

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

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)

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

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

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)))"])

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)))"])