Transients: mutable backing instead of copy-on-write

The Chez port had landed transients as copy-on-write — each conj!/assoc!/etc.
rebuilt the whole persistent collection. Semantics were right but a transient
vector was O(n^2) to build (the persistent vector is a flat array, so every
conj! copied it); maps/sets were ~O(n log n) since the HAMT only path-copies.
This restores the Janet host's approach: true mutable backing, snapshot once on
persistent!.

  vec : a growable Scheme vector (capacity + fill count); conj!/pop! amortized
        O(1), persistent! hands off the buffer (exact fit) or trims once.
  map : a Chez hashtable keyed by key-hash/jolt= (value equality, nil-safe);
        persistent! folds it into a pmap.
  set : a Chez hashtable; persistent! folds into a pset.
  cow : fallback for anything else (e.g. a sorted coll) keeps the old
        copy-on-write path, preserving jolt's superset.

get/count/contains?/nth see through each representation. Building a 400k vector
went from minutes (quadratic) to ~50ms (linear). assoc! keeps the variadic
dangling-key nil-pad on both vectors and maps. test/chez/transient-test.ss pins
the invariants and the linear-time property; wired in as `make transient`.

Makefile

@@ -4,7 +4,7 @@
 # build step. `make test` is the full gate. `make remint` rebuilds the seed after a
 # source change.
 
-.PHONY: test ci values corpus unit smoke selfhost sci certify ffi remint
+.PHONY: test ci values corpus unit smoke selfhost sci certify ffi transient remint
 
 # Full gate (dev machine). Includes the self-host byte-fixpoint, which only holds
 # on the same Chez that minted the seed.
@@ -15,7 +15,7 @@ test: selfhost ci
 # lockfile) — it RUNS correctly on any Chez, but `selfhost` rebuilds it and a
 # different Chez version may emit byte-different (gensym/order) output, so the
 # byte-fixpoint is a dev-machine check, not a CI one (jolt-8479).
-ci: values corpus unit smoke sci ffi certify
+ci: values corpus unit smoke sci ffi transient certify
 	@echo "OK: CI gates passed"
 
 # Self-host fixpoint: bootstrap.ss rebuild == checked-in seed.
@@ -47,6 +47,10 @@ sci:
 ffi:
 	@chez --script test/chez/ffi-server-test.ss
 
+# Transients: mutable backing, snapshot on persistent!, and linear-time builds.
+transient:
+	@chez --script test/chez/transient-test.ss
+
 # JVM oracle: certify the corpus against reference Clojure. Skips if clojure absent.
 certify:
 	@if command -v clojure >/dev/null 2>&1; then \

host/chez/printing.ss

@@ -37,7 +37,8 @@
     ;; multimethod; the readable fallback renders it directly).
     ;; forward refs to transients.ss (loaded later) — resolved at call time.
     ((jolt-transient? x)
-     (if (pvec? (jolt-transient-coll x)) "#<transient vector>" "#<transient map>"))
+     (case (jolt-transient-kind x)
+       ((vec) "#<transient vector>") ((set) "#<transient set>") (else "#<transient map>")))
     ((pvec? x)
      (let ((acc '()))
        (let loop ((i (fx- (pvec-count x) 1)))

host/chez/transients.ss

@@ -1,31 +1,103 @@
-;; transients (jolt-kl2l) — copy-on-write over the persistent collections.
+;; transients (jolt-kl2l) — mutable backing per collection kind, snapshotted to
+;; the immutable collection on persistent!. A faithful port of the Janet host's
+;; mutable transients: conj!/assoc!/dissoc!/disj!/pop! mutate in place (amortized
+;; O(1)); persistent! converts back to a pvec / pmap / pset once.
 ;;
-;; A first cut: each transient op rebuilds the persistent collection (no in-place
+;;   vec : a growable Scheme vector (capacity) + a fill count `n`. conj!/pop! are
-;; mutation perf), but the SEMANTICS match — the overlay's transient users (into,
+;;         O(1) amortized — the old copy-on-write rebuilt the whole vector per op,
-;; frequencies, group-by) get correct results. get/count/contains? are extended to
+;;         so building an N-vector was O(N^2).
-;; see THROUGH a transient to its held collection (frequencies/group-by do
+;;   map : a Chez hashtable keyed by key-hash / jolt= (value-equality, nil-safe —
-;; (get tm k) on a transient map). vector? on a transient vector is false (it's a
+;;         a jolt-nil key stores fine here, unlike a Janet table).
-;; jolt-transient record, not a pvec), which group-by relies on. Loaded after
+;;   set : a Chez hashtable of elements.
-;; collections.ss (the persistent ops it delegates to) and converters.ss.
+;;   cow : fallback for anything else (e.g. a sorted coll) — copy-on-write over
+;;         the persistent ops, preserving jolt's superset of Clojure's transients.
+;;
+;; get/count/contains?/nth see THROUGH a transient (frequencies/group-by read a
+;; transient map; a transient is callable). vector? on a transient is false (it's
+;; this record, not a pvec), which group-by relies on. Loaded after collections.ss
+;; (persistent ops + key-hash) and converters.ss.
 
-(define-record-type jolt-transient (fields (mutable coll) (mutable active))
+(define-record-type jolt-transient
-  (nongenerative jolt-transient-v1))
+  (fields kind (mutable buf) (mutable n) (mutable active))
+  (nongenerative jolt-transient-v2))
 
-(define (jolt-transient-new coll) (make-jolt-transient coll #t))
+(define tvec-min-cap 8)
+
+(define (jolt-transient-new coll)
+  (cond
+    ((pvec? coll)
+     (let* ((v (pvec-v coll)) (cnt (vector-length v)) (cap (fxmax tvec-min-cap cnt))
+            (buf (make-vector cap jolt-nil)))
+       (let loop ((i 0)) (when (fx<? i cnt) (vector-set! buf i (vector-ref v i)) (loop (fx+ i 1))))
+       (make-jolt-transient 'vec buf cnt #t)))
+    ((pmap? coll)
+     (let ((ht (make-hashtable key-hash jolt=2)))
+       (pmap-fold coll (lambda (k v acc) (hashtable-set! ht k v) acc) 0)
+       (make-jolt-transient 'map ht 0 #t)))
+    ((pset? coll)
+     (let ((ht (make-hashtable key-hash jolt=2)))
+       (pset-fold coll (lambda (e acc) (hashtable-set! ht e #t) acc) 0)
+       (make-jolt-transient 'set ht 0 #t)))
+    (else (make-jolt-transient 'cow coll 0 #t))))
 
 (define (jolt-trans-check t who)
   (unless (jolt-transient? t) (error #f (string-append who ": not a transient") t))
-  (unless (jolt-transient-active t)
+  (unless (jolt-transient-active t) (error #f (string-append who ": transient used after persistent!"))))
-    (error #f (string-append who ": transient used after persistent!"))))
 
+;; --- persistent! : snapshot back to the immutable collection -----------------
 (define (jolt-persistent! t)
   (jolt-trans-check t "persistent!")
   (jolt-transient-active-set! t #f)
-  (jolt-transient-coll t))
+  (case (jolt-transient-kind t)
+    ((vec)
+     (let ((buf (jolt-transient-buf t)) (cnt (jolt-transient-n t)))
+       ;; exact fit: hand off the buffer (no other reference exists, and the
+       ;; transient is now inactive so it can't mutate it). Else trim to size —
+       ;; a pvec's backing length must equal its count.
+       (if (fx=? cnt (vector-length buf))
+           (make-pvec buf)
+           (let ((out (make-vector cnt)))
+             (let loop ((i 0))
+               (if (fx<? i cnt) (begin (vector-set! out i (vector-ref buf i)) (loop (fx+ i 1)))
+                   (make-pvec out)))))))
+    ((map)
+     (let ((ht (jolt-transient-buf t)) (m empty-pmap))
+       (vector-for-each (lambda (k) (set! m (pmap-assoc m k (hashtable-ref ht k jolt-nil)))) (hashtable-keys ht))
+       m))
+    ((set)
+     (let ((ht (jolt-transient-buf t)) (s empty-pset))
+       (vector-for-each (lambda (e) (set! s (pset-conj s e))) (hashtable-keys ht))
+       s))
+    (else (jolt-transient-buf t))))
 
-;; (conj!) with no args -> a fresh transient vector (Clojure); (conj! coll) is the
+;; --- in-place mutation -------------------------------------------------------
-;; 1-arity transducer-completion arity, which returns coll as-is with NO transient
+(define (tvec-ensure! t need)            ; grow capacity to >= need by doubling
-;; check (JVM: conj! 1-arity is identity); otherwise mutate t.
+  (let ((buf (jolt-transient-buf t)))
+    (when (fx>? need (vector-length buf))
+      (let* ((ncap (let grow ((c (fxmax tvec-min-cap (vector-length buf)))) (if (fx>=? c need) c (grow (fx* 2 c)))))
+             (nbuf (make-vector ncap jolt-nil)) (cnt (jolt-transient-n t)))
+        (let loop ((i 0)) (when (fx<? i cnt) (vector-set! nbuf i (vector-ref buf i)) (loop (fx+ i 1))))
+        (jolt-transient-buf-set! t nbuf)))))
+(define (tvec-conj1! t x)
+  (let ((cnt (jolt-transient-n t)))
+    (tvec-ensure! t (fx+ cnt 1))
+    (vector-set! (jolt-transient-buf t) cnt x)
+    (jolt-transient-n-set! t (fx+ cnt 1))))
+(define (tvec-assoc1! t i x)
+  (let ((i (->idx i)) (cnt (jolt-transient-n t)))
+    (cond ((and (fixnum? i) (fx>=? i 0) (fx<? i cnt)) (vector-set! (jolt-transient-buf t) i x))
+          ((and (fixnum? i) (fx=? i cnt)) (tvec-conj1! t x))
+          (else (error #f "assoc!: index out of bounds")))))
+;; conj! onto a transient map: a [k v] pair (vector/map-entry) or a whole map.
+(define (tmap-conj-entry! t x)
+  (cond
+    ((jolt-nil? x) #t)
+    ((pvec? x) (hashtable-set! (jolt-transient-buf t) (pvec-nth-d x 0 jolt-nil) (pvec-nth-d x 1 jolt-nil)))
+    ((pmap? x) (pmap-fold x (lambda (k v acc) (hashtable-set! (jolt-transient-buf t) k v) acc) 0))
+    (else (error #f "conj!: a transient map takes a map entry or a map" x))))
+
+;; (conj!) -> fresh transient vector; (conj! coll) -> the 1-arity transducer-
+;; completion identity (JVM: no transient check). (conj! t x ...) mutates t.
 (define (jolt-conj! . args)
   (cond
     ((null? args) (jolt-transient-new (jolt-vector)))
@@ -33,55 +105,96 @@
     (else
       (let ((t (car args)) (xs (cdr args)))
         (jolt-trans-check t "conj!")
-        (jolt-transient-coll-set! t (apply jolt-conj (jolt-transient-coll t) xs))
+        (case (jolt-transient-kind t)
+          ((vec) (for-each (lambda (x) (tvec-conj1! t x)) xs))
+          ((set) (for-each (lambda (x) (hashtable-set! (jolt-transient-buf t) x #t)) xs))
+          ((map) (for-each (lambda (x) (tmap-conj-entry! t x)) xs))
+          (else (jolt-transient-buf-set! t (apply jolt-conj (jolt-transient-buf t) xs))))
         t))))
-;; (assoc! t k v & kvs): variadic like Clojure (jolt-assoc already folds pairs).
+
-(define (jolt-assoc! t . kvs)
+;; assoc! is variadic. JVM: a complete first key/val pair present (>=3 kvs) with a
+;; trailing lone key fills nil; a lone key alone (1 kv) is a wrong-arity throw.
+(define (assoc-pad kvs) (if (and (>= (length kvs) 3) (odd? (length kvs))) (append kvs (list jolt-nil)) kvs))
+(define (jolt-assoc! t . kvs0)
   (jolt-trans-check t "assoc!")
-  ;; JVM assoc! is variadic: once a complete first key/val pair is present (>=3
+  (let ((kvs (assoc-pad kvs0)))
-  ;; kvs), a TRAILING lone key fills nil; a lone key alone (1 kv) is a wrong-arity
+    (when (odd? (length kvs)) (error #f "assoc!: no value supplied for key"))
-  ;; throw (so don't pad it — the persistent assoc raises on odd args).
+    (case (jolt-transient-kind t)
-  (let ((kvs (if (and (>= (length kvs) 3) (odd? (length kvs)))
+      ((map) (let lp ((xs kvs)) (unless (null? xs) (hashtable-set! (jolt-transient-buf t) (car xs) (cadr xs)) (lp (cddr xs)))))
-                 (append kvs (list jolt-nil))
+      ((vec) (let lp ((xs kvs)) (unless (null? xs) (tvec-assoc1! t (car xs) (cadr xs)) (lp (cddr xs)))))
-                 kvs)))
+      (else (jolt-transient-buf-set! t (apply jolt-assoc (jolt-transient-buf t) kvs)))))
-    (jolt-transient-coll-set! t (apply jolt-assoc (jolt-transient-coll t) kvs)))
   t)
 (define (jolt-dissoc! t . ks)
   (jolt-trans-check t "dissoc!")
-  (jolt-transient-coll-set! t (apply jolt-dissoc (jolt-transient-coll t) ks))
+  (case (jolt-transient-kind t)
+    ((map) (for-each (lambda (k) (hashtable-delete! (jolt-transient-buf t) k)) ks))
+    (else (jolt-transient-buf-set! t (apply jolt-dissoc (jolt-transient-buf t) ks))))
   t)
 (define (jolt-disj! t . xs)
   (jolt-trans-check t "disj!")
-  (jolt-transient-coll-set! t (apply jolt-disj (jolt-transient-coll t) xs))
+  (case (jolt-transient-kind t)
+    ((set) (for-each (lambda (x) (hashtable-delete! (jolt-transient-buf t) x)) xs))
+    (else (jolt-transient-buf-set! t (apply jolt-disj (jolt-transient-buf t) xs))))
   t)
 (define (jolt-pop! t)
   (jolt-trans-check t "pop!")
-  (jolt-transient-coll-set! t (jolt-pop (jolt-transient-coll t)))
+  (case (jolt-transient-kind t)
+    ((vec) (let ((cnt (jolt-transient-n t)))
+             (if (fx=? cnt 0) (error #f "pop!: can't pop empty transient vector")
+                 (jolt-transient-n-set! t (fx- cnt 1)))))
+    (else (jolt-transient-buf-set! t (jolt-pop (jolt-transient-buf t)))))
   t)
 
 ;; persistent disj over sets (pset-disj already exists in collections.ss).
 (define (jolt-disj s . xs)
   (let loop ((s s) (xs xs)) (if (null? xs) s (loop (pset-disj s (car xs)) (cdr xs)))))
 
-;; get / count / contains? see through a transient. Redefine the native procedures
+;; --- see-through accessors ---------------------------------------------------
-;; (captured first) so the existing emit lowerings (jolt-get/jolt-count/
+(define (tvec-in-bounds? t i) (and (fixnum? i) (fx>=? i 0) (fx<? i (jolt-transient-n t))))
-;; jolt-contains?) unwrap a transient before delegating; non-transients are
+(define (t-get t k d)
-;; untouched.
+  (case (jolt-transient-kind t)
-(define (jolt-deref-transient x) (if (jolt-transient? x) (jolt-transient-coll x) x))
+    ((vec) (let ((i (->idx k))) (if (tvec-in-bounds? t i) (vector-ref (jolt-transient-buf t) i) d)))
+    ((map) (hashtable-ref (jolt-transient-buf t) k d))
+    ((set) (if (hashtable-contains? (jolt-transient-buf t) k) k d))
+    (else (%prev-jolt-get (jolt-transient-buf t) k d))))
+(define (t-count t)
+  (case (jolt-transient-kind t)
+    ((vec) (jolt-transient-n t))
+    ((map set) (hashtable-size (jolt-transient-buf t)))
+    (else (%prev-jolt-count (jolt-transient-buf t)))))
+(define (t-contains? t k)
+  (case (jolt-transient-kind t)
+    ((vec) (tvec-in-bounds? t (->idx k)))
+    ((map set) (hashtable-contains? (jolt-transient-buf t) k))
+    (else (%prev-jolt-contains? (jolt-transient-buf t) k))))
+
+;; Redefine the native get/count/contains?/nth (captured first) so the existing
+;; emit lowerings unwrap a transient; non-transients are untouched.
 (define %prev-jolt-get jolt-get)
 (set! jolt-get
   (case-lambda
-    ((coll k) (%prev-jolt-get (jolt-deref-transient coll) k))
+    ((coll k) (if (jolt-transient? coll) (t-get coll k jolt-nil) (%prev-jolt-get coll k)))
-    ((coll k d) (%prev-jolt-get (jolt-deref-transient coll) k d))))
+    ((coll k d) (if (jolt-transient? coll) (t-get coll k d) (%prev-jolt-get coll k d)))))
 (define %prev-jolt-count jolt-count)
-(set! jolt-count (lambda (coll) (%prev-jolt-count (jolt-deref-transient coll))))
+(set! jolt-count (lambda (coll) (if (jolt-transient? coll) (t-count coll) (%prev-jolt-count coll))))
 (define %prev-jolt-contains? jolt-contains?)
-(set! jolt-contains? (lambda (coll k) (%prev-jolt-contains? (jolt-deref-transient coll) k)))
+(set! jolt-contains? (lambda (coll k) (if (jolt-transient? coll) (t-contains? coll k) (%prev-jolt-contains? coll k))))
 (define %prev-jolt-nth jolt-nth)
 (set! jolt-nth
   (case-lambda
-    ((coll i) (%prev-jolt-nth (jolt-deref-transient coll) i))
+    ((coll i)
-    ((coll i d) (%prev-jolt-nth (jolt-deref-transient coll) i d))))
+     (if (jolt-transient? coll)
+         (if (eq? (jolt-transient-kind coll) 'vec)
+             (let ((idx (->idx i)))
+               (if (tvec-in-bounds? coll idx) (vector-ref (jolt-transient-buf coll) idx) (error 'nth "index out of bounds")))
+             (%prev-jolt-nth (jolt-transient-buf coll) i))
+         (%prev-jolt-nth coll i)))
+    ((coll i d)
+     (if (jolt-transient? coll)
+         (if (eq? (jolt-transient-kind coll) 'vec)
+             (let ((idx (->idx i))) (if (tvec-in-bounds? coll idx) (vector-ref (jolt-transient-buf coll) idx) d))
+             (%prev-jolt-nth (jolt-transient-buf coll) i d))
+         (%prev-jolt-nth coll i d)))))
 
 (def-var! "clojure.core" "transient" jolt-transient-new)
 (def-var! "clojure.core" "persistent!" jolt-persistent!)

test/chez/transient-test.ss

@@ -0,0 +1,48 @@
+;; Transient regression: mutable backing + snapshot-on-persist (jolt-kl2l). Run:
+;;   chez --script test/chez/transient-test.ss
+;; Semantics are covered broadly by the corpus; this pins the invariants the
+;; mutable port must keep AND that large builds stay linear (a copy-on-write
+;; regression would make the 200k builds quadratic and time the gate out).
+
+(import (chezscheme))
+(load "host/chez/rt.ss")
+(set-chez-ns! "clojure.core")
+(load "host/chez/seed/prelude.ss")
+(load "host/chez/post-prelude.ss")
+(set-chez-ns! "user")
+(load "host/chez/host-contract.ss")
+(load "host/chez/seed/image.ss")
+(load "host/chez/compile-eval.ss")
+
+(define total 0) (define fails 0)
+(define (ok name pred) (set! total (+ total 1)) (unless pred (set! fails (+ fails 1)) (printf "FAIL: ~a\n" name)))
+(define (ev s) (jolt-final-str (jolt-compile-eval (string-append "(do " s ")") "user")))
+(define (is name s expect) (ok (string-append name " => " expect) (string=? (ev s) expect)))
+
+;; --- mutation is in place; persistent! snapshots back -----------------------
+(is "vector build" "(persistent! (reduce conj! (transient []) (range 5)))" "[0 1 2 3 4]")
+(is "map build"    "(= {0 0 1 1 2 2} (persistent! (reduce (fn [t i] (assoc! t i i)) (transient {}) (range 3))))" "true")
+(is "set build"    "(count (persistent! (reduce conj! (transient #{}) [1 2 2 3])))" "3")
+(is "pop!"         "(persistent! (pop! (conj! (transient [1 2]) 3)))" "[1 2]")
+(is "dissoc!"      "(persistent! (dissoc! (assoc! (transient {}) :a 1 :b 2) :a))" "{:b 2}")
+(is "disj!"        "(persistent! (disj! (conj! (transient #{}) :x :y) :x))" "#{:y}")
+
+;; --- a transient never mutates its source -----------------------------------
+(is "source map unchanged"    "(let [m {:a 1} _ (persistent! (assoc! (transient m) :b 2))] (= m {:a 1}))" "true")
+(is "source vector unchanged" "(let [v [1 2] _ (persistent! (conj! (transient v) 3))] (= v [1 2]))" "true")
+
+;; --- edges the port must keep -----------------------------------------------
+(is "nil key"            "(get (persistent! (assoc! (transient {}) nil :v)) nil)" ":v")
+(is "collection key"     "(get (persistent! (assoc! (transient {}) [1 2] :v)) [1 2])" ":v")
+(is "dangling key pads"  "(= {:a 1 :b nil} (persistent! (assoc! (transient {}) :a 1 :b)))" "true")
+(is "vector? is false"   "(vector? (transient []))" "false")
+(is "transient sorted (cow)" "(persistent! (assoc! (transient (sorted-map :b 2)) :a 1))" "{:a 1, :b 2}")
+(ok "lone key throws"        (guard (e (#t #t)) (ev "(persistent! (assoc! (transient {}) :a))") #f))
+(ok "use after persistent!"  (guard (e (#t #t)) (ev "(let [t (transient [])] (persistent! t) (conj! t 1))") #f))
+
+;; --- linear, not quadratic: 200k builds finish near-instantly ---------------
+(is "big vector build"  "(count (persistent! (reduce conj! (transient []) (range 200000))))" "200000")
+(is "big map build"     "(count (persistent! (reduce (fn [t i] (assoc! t i i)) (transient {}) (range 200000))))" "200000")
+
+(printf "~a/~a passed~n" (- total fails) total)
+(exit (if (zero? fails) 0 1))