persistent: nongenerative UIDs on pmap/pvec/pset/tmap/tset RTDs

ober

ec879e1d96396356608781e6caa401d134d1518a

diff --git a/lib/std/pmap.sls b/lib/std/pmap.sls
index eb14a6a..62bb82c 100644
--- a/lib/std/pmap.sls
+++ b/lib/std/pmap.sls
@@ -91,7 +91,12 @@
     (fields (mutable edit) hash (mutable pairs)))  ; pairs = list of (key . val)
 
   ;;; ========== The map record ==========
+  ;; nongenerative UID pins the RTD across compilation units so
+  ;; cp0 can fold (persistent-map? x) when x's type is known and
+  ;; cptypes can (eventually) specialize persistent-map-ref / has?
+  ;; on known-pmap arguments.  Round 4 Phase 29.
   (define-record-type %pmap
+    (nongenerative jerboa-pmap-v1)
     (fields root size equal-proc hash-proc))
 
   (define (persistent-map? x) (%pmap? x))
@@ -576,6 +581,7 @@
   ;; with `eq?` identity comparison on the box itself.
 
   (define-record-type %tmap
+    (nongenerative jerboa-tmap-v1)
     (fields
       (mutable root)
       (mutable size)
diff --git a/lib/std/pset.sls b/lib/std/pset.sls
index ff8b085..02b4feb 100644
--- a/lib/std/pset.sls
+++ b/lib/std/pset.sls
@@ -67,7 +67,11 @@
 
   ;;; ========== Set record ==========
 
+  ;; nongenerative UID: pins the RTD across compilation units so cp0
+  ;; can fold (persistent-set? x) when x's type is known statically.
+  ;; Round 4 Phase 29.
   (define-record-type %pset
+    (nongenerative jerboa-pset-v1)
     (fields (immutable map)))     ;; wraps an underlying %pmap
 
   (define (persistent-set? x) (%pset? x))
@@ -215,6 +219,7 @@
   ;; keys are the set elements.
 
   (define-record-type %tset
+    (nongenerative jerboa-tset-v1)
     (fields (immutable tmap)))
 
   (define (transient-set s)
diff --git a/lib/std/pvec.sls b/lib/std/pvec.sls
index 9b4c28f..655b9b8 100644
--- a/lib/std/pvec.sls
+++ b/lib/std/pvec.sls
@@ -56,7 +56,11 @@
   ;; shift  — tree height in bits (BITS per level; starts at BITS, grows by BITS)
   ;; root   — trie root (pvec-node)
   ;; tail   — vector of the last up-to-32 elements (not in trie)
+  ;; nongenerative UID: pins the RTD across compilation units so cp0
+  ;; can fold (persistent-vector? x) when x's type is known statically.
+  ;; Round 4 Phase 29.
   (define-record-type %pvec
+    (nongenerative jerboa-pvec-v1)
     (fields count shift root tail))
 
   (define (persistent-vector? x) (%pvec? x))
@@ -277,6 +281,7 @@
   ;; Can be upgraded to a true transient trie for better performance.
 
   (define-record-type %transient
+    (nongenerative jerboa-pvec-transient-v1)
     (fields (mutable items) (mutable count) (mutable done?))
     (protocol (lambda (new)
       (lambda (items count) (new items count #f)))))
diff --git a/tests/test-persistent-nongenerative.ss b/tests/test-persistent-nongenerative.ss
new file mode 100644
index 0000000..37a8be8
--- /dev/null
+++ b/tests/test-persistent-nongenerative.ss
@@ -0,0 +1,68 @@
+#!chezscheme
+;;; Regression test pinning nongenerative UIDs on persistent collection
+;;; record types.  Phase 29 of Round 4.
+;;;
+;;; Purpose: ensure the RTDs keep stable UIDs so cp0 can fold predicates
+;;; across compilation units and future cptypes extensions can track
+;;; pmap/pvec/pset types via stable identity.  If someone removes the
+;;; nongenerative clause (or renames the UID) this test fails loudly.
+
+(import (chezscheme) (std pmap) (std pvec) (std pset))
+
+(define pass 0)
+(define fail 0)
+
+(define-syntax test
+  (syntax-rules ()
+    [(_ name expr expected)
+     (guard (exn [#t (set! fail (+ fail 1))
+                     (printf "FAIL ~a: ~a~%" name
+                       (if (message-condition? exn) (condition-message exn) exn))])
+       (let ([got expr])
+         (if (equal? got expected)
+             (begin (set! pass (+ pass 1)) (printf "  ok ~a~%" name))
+             (begin (set! fail (+ fail 1))
+                    (printf "FAIL ~a: got ~s expected ~s~%" name got expected)))))]))
+
+(printf "--- Round 4 Phase 29: nongenerative UID pins ---~%~%")
+
+(test "pmap RTD has expected UID"
+  (record-type-uid (record-rtd (make-persistent-map)))
+  'jerboa-pmap-v1)
+
+(test "pvec RTD has expected UID"
+  (record-type-uid (record-rtd (persistent-vector)))
+  'jerboa-pvec-v1)
+
+(test "pset RTD has expected UID"
+  (record-type-uid (record-rtd (make-persistent-set)))
+  'jerboa-pset-v1)
+
+(test "tmap RTD has expected UID"
+  (record-type-uid (record-rtd (transient-map pmap-empty)))
+  'jerboa-tmap-v1)
+
+(test "tset RTD has expected UID"
+  (record-type-uid (record-rtd (transient-set pset-empty)))
+  'jerboa-tset-v1)
+
+;; RTD identity across separate constructor calls (same library, same run)
+(test "pmap RTDs are eq? across instances"
+  (eq? (record-rtd (make-persistent-map))
+       (record-rtd (make-persistent-map 'a 1)))
+  #t)
+
+(test "pvec RTDs are eq? across instances"
+  (eq? (record-rtd (persistent-vector))
+       (record-rtd (persistent-vector 1 2 3)))
+  #t)
+
+(test "pset RTDs are eq? across instances"
+  (eq? (record-rtd (make-persistent-set))
+       (record-rtd (make-persistent-set 1)))
+  #t)
+
+(printf "~%--- Results: ~a/~a passed, ~a failed ---~%"
+  pass (+ pass fail) fail)
+
+(exit (if (= fail 0) 0 1))