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>

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