persistent: wire pmap/pvec/pset into Chez equal?/equal-hash/display
ober
28705c5bb5b606e87163458639195e7dafab5e58
--- a/lib/std/pmap.sls +++ b/lib/std/pmap.sls @@ -865,4 +865,29 @@ ;; transient version re-uses a single %tmap wrapper end-to-end and ;; produces the final %pmap only once, in persistent-map!. + ;;; ========== Chez equal? / equal-hash integration ========== + ;; Plumbs persistent-map=? / persistent-map-hash into Chez's generic + ;; equality protocol so that (equal? pm1 pm2) holds when the two + ;; maps have the same entries regardless of insertion order, and a + ;; pmap can be used as a key in an equal-hashtable. + (record-type-equal-procedure (record-type-descriptor %pmap) + (lambda (a b rec-equal?) (persistent-map=? a b))) + (record-type-hash-procedure (record-type-descriptor %pmap) + (lambda (m rec-hash) (persistent-map-hash m))) + + ;;; ========== Printer ========== + ;; Surface form: {k1 v1 k2 v2}. No commas, matching Clojure minus + ;; keyword colons. Not round-trippable without a reader macro, but + ;; readable for REPL / debugging / logs. + (record-writer (record-type-descriptor %pmap) + (lambda (pm port wr) + (write-char #\{ port) + (let ([first? #t]) + (persistent-map-for-each + (lambda (k v) + (if first? (set! first? #f) (write-char #\space port)) + (wr k port) (write-char #\space port) (wr v port)) + pm)) + (write-char #\} port))) + ) ;; end library --- a/lib/std/pset.sls +++ b/lib/std/pset.sls @@ -250,4 +250,26 @@ (tset-check 'persistent-set! t) (make-%pset (persistent-map! (%tset-tmap t)))) + ;;; ========== Chez equal? / equal-hash integration ========== + ;; Two sets with the same elements compare equal via (equal? s1 s2) + ;; and hash to the same value, so a pset can key an equal-hashtable. + (record-type-equal-procedure (record-type-descriptor %pset) + (lambda (a b rec-equal?) (persistent-set=? a b))) + (record-type-hash-procedure (record-type-descriptor %pset) + (lambda (s rec-hash) (persistent-set-hash s))) + + ;;; ========== Printer ========== + ;; Surface form: #{e1 e2 e3}. Matches Clojure set literal syntax. + (record-writer (record-type-descriptor %pset) + (lambda (s port wr) + (write-char #\# port) + (write-char #\{ port) + (let ([first? #t]) + (persistent-set-for-each + (lambda (x) + (if first? (set! first? #f) (write-char #\space port)) + (wr x port)) + s)) + (write-char #\} port))) + ) ;; end library --- a/lib/std/pvec.sls +++ b/lib/std/pvec.sls @@ -22,7 +22,9 @@ persistent-vector-map persistent-vector-fold persistent-vector-filter persistent-vector-concat persistent-vector-slice persistent-vector-prepend ;; Transients: batch mutation without per-step copying - transient transient? transient-ref transient-set! transient-append! persistent!) + transient transient? transient-ref transient-set! transient-append! persistent! + ;; Structural equality / hashing + persistent-vector=? persistent-vector-hash) (import (chezscheme)) @@ -325,4 +327,90 @@ v (loop (+ i 1) (persistent-vector-append v (vector-ref items i))))))) + ;;; ========== Structural equality ========== + ;; Element order matters: two pvecs are equal iff they have the same + ;; length and corresponding elements are pvec-val=?. + (define (pvec-val=? a b) + (cond + [(and (%pvec? a) (%pvec? b)) (persistent-vector=? a b)] + [(and (pair? a) (pair? b)) + (and (pvec-val=? (car a) (car b)) + (pvec-val=? (cdr a) (cdr b)))] + [(and (vector? a) (vector? b)) + (let ([la (vector-length a)]) + (and (= la (vector-length b)) + (let loop ([i 0]) + (cond + [(= i la) #t] + [(pvec-val=? (vector-ref a i) (vector-ref b i)) + (loop (+ i 1))] + [else #f]))))] + [else (equal? a b)])) + + (define (persistent-vector=? v1 v2) + (cond + [(eq? v1 v2) #t] + [(not (%pvec? v1)) #f] + [(not (%pvec? v2)) #f] + [(not (= (%pvec-count v1) (%pvec-count v2))) #f] + [else + (let ([n (%pvec-count v1)]) + (let loop ([i 0]) + (cond + [(= i n) #t] + [(pvec-val=? (persistent-vector-ref v1 i) + (persistent-vector-ref v2 i)) + (loop (+ i 1))] + [else #f])))])) + + ;;; ========== Structural hash ========== + ;; Order-dependent: each element's hash is position-mixed so that + ;; reversing the vector changes the hash. + (define (pvec-val-hash x) + (cond + [(%pvec? x) (persistent-vector-hash x)] + [(pair? x) + (bitwise-xor (pvec-val-hash (car x)) + (bitwise-arithmetic-shift (pvec-val-hash (cdr x)) 1))] + [(vector? x) + (let ([len (vector-length x)]) + (let loop ([i 0] [h len]) + (if (= i len) + h + (loop (+ i 1) + (bitwise-xor h + (bitwise-arithmetic-shift + (pvec-val-hash (vector-ref x i)) 3))))))] + [else (equal-hash x)])) + + (define (persistent-vector-hash v) + (let ([n (%pvec-count v)]) + (let loop ([i 0] [h n]) + (if (= i n) + h + (loop (+ i 1) + (bitwise-xor + (bitwise-arithmetic-shift h 5) + (pvec-val-hash (persistent-vector-ref v i)))))))) + + ;;; ========== Chez equal? / equal-hash integration ========== + (record-type-equal-procedure (record-type-descriptor %pvec) + (lambda (a b rec-equal?) (persistent-vector=? a b))) + (record-type-hash-procedure (record-type-descriptor %pvec) + (lambda (v rec-hash) (persistent-vector-hash v))) + + ;;; ========== Printer ========== + ;; Surface form: [e1 e2 e3]. Square brackets distinguish from plain + ;; Chez vectors (#(...)). Not round-trippable without a reader macro. + (record-writer (record-type-descriptor %pvec) + (lambda (v port wr) + (write-char #\[ port) + (let ([n (%pvec-count v)]) + (let loop ([i 0]) + (when (< i n) + (unless (= i 0) (write-char #\space port)) + (wr (persistent-vector-ref v i) port) + (loop (+ i 1))))) + (write-char #\] port))) + ) ;; end library new file mode 100644 --- /dev/null +++ b/tests/test-persistent-equal.ss @@ -0,0 +1,166 @@ +#!chezscheme +;;; Tests for Chez equal? / equal-hash integration on persistent +;;; collections (pmap, pvec, pset). Phase 25 of Round 4. +;;; +;;; Contract: +;;; - (equal? pm1 pm2) holds when pm1 and pm2 have the same entries, +;;; independent of insertion order. +;;; - (equal-hash pm) is the same for equal maps. +;;; - pmap/pvec/pset can be keys in an equal-hashtable. + +(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 25: equal? / equal-hash integration ---~%~%") + +;;; ========== pmap ========== + +(test "pm equal same order" + (equal? (make-persistent-map 'a 1 'b 2) + (make-persistent-map 'a 1 'b 2)) + #t) + +(test "pm equal reversed order" + (equal? (make-persistent-map 'a 1 'b 2) + (make-persistent-map 'b 2 'a 1)) + #t) + +(test "pm not equal different values" + (equal? (make-persistent-map 'a 1) + (make-persistent-map 'a 2)) + #f) + +(test "pm not equal different sizes" + (equal? (make-persistent-map 'a 1) + (make-persistent-map 'a 1 'b 2)) + #f) + +(test "pm hash equal for equal maps" + (= (equal-hash (make-persistent-map 'a 1 'b 2)) + (equal-hash (make-persistent-map 'b 2 'a 1))) + #t) + +(test "pm nested equal" + (equal? + (make-persistent-map 'outer (make-persistent-map 'x 1)) + (make-persistent-map 'outer (make-persistent-map 'x 1))) + #t) + +(test "pm as equal-hashtable key" + (let ([ht (make-hashtable equal-hash equal?)] + [k1 (make-persistent-map 'a 1 'b 2)] + [k2 (make-persistent-map 'b 2 'a 1)]) + (hashtable-set! ht k1 "v") + (hashtable-ref ht k2 #f)) + "v") + +;;; ========== pvec ========== + +(test "pv equal same elements" + (equal? (persistent-vector 1 2 3) + (persistent-vector 1 2 3)) + #t) + +(test "pv not equal different elements" + (equal? (persistent-vector 1 2 3) + (persistent-vector 1 2 4)) + #f) + +(test "pv not equal reversed" + (equal? (persistent-vector 1 2 3) + (persistent-vector 3 2 1)) + #f) + +(test "pv not equal different lengths" + (equal? (persistent-vector 1 2 3) + (persistent-vector 1 2 3 4)) + #f) + +(test "pv hash equal for equal vectors" + (= (equal-hash (persistent-vector 'a 'b 'c)) + (equal-hash (persistent-vector 'a 'b 'c))) + #t) + +(test "pv large equal" + (let* ([lst (iota 100)] + [v1 (list->persistent-vector lst)] + [v2 (list->persistent-vector lst)]) + (equal? v1 v2)) + #t) + +(test "pv nested pmap equal" + (equal? + (persistent-vector (make-persistent-map 'k 1)) + (persistent-vector (make-persistent-map 'k 1))) + #t) + +(test "pv as equal-hashtable key" + (let ([ht (make-hashtable equal-hash equal?)] + [k1 (persistent-vector 1 2 3)] + [k2 (persistent-vector 1 2 3)]) + (hashtable-set! ht k1 "vec") + (hashtable-ref ht k2 #f)) + "vec") + +;;; ========== pset ========== + +(test "ps equal same order" + (equal? (make-persistent-set 1 2 3) + (make-persistent-set 1 2 3)) + #t) + +(test "ps equal reversed order" + (equal? (make-persistent-set 1 2 3) + (make-persistent-set 3 2 1)) + #t) + +(test "ps not equal" + (equal? (make-persistent-set 1 2 3) + (make-persistent-set 1 2 4)) + #f) + +(test "ps hash equal for equal sets" + (= (equal-hash (make-persistent-set 'a 'b 'c)) + (equal-hash (make-persistent-set 'c 'a 'b))) + #t) + +(test "ps as equal-hashtable key" + (let ([ht (make-hashtable equal-hash equal?)] + [k1 (make-persistent-set 'a 'b)] + [k2 (make-persistent-set 'b 'a)]) + (hashtable-set! ht k1 "set") + (hashtable-ref ht k2 #f)) + "set") + +;;; ========== Mixed nesting ========== + +(test "pmap with pvec value" + (equal? + (make-persistent-map 'lst (persistent-vector 1 2 3)) + (make-persistent-map 'lst (persistent-vector 1 2 3))) + #t) + +(test "pvec with pset element" + (equal? + (persistent-vector (make-persistent-set 1 2)) + (persistent-vector (make-persistent-set 2 1))) + #t) + +(printf "~%--- Results: ~a/~a passed, ~a failed ---~%" + pass (+ pass fail) fail) + +(exit (if (= fail 0) 0 1)) new file mode 100644 --- /dev/null +++ b/tests/test-persistent-printers.ss @@ -0,0 +1,89 @@ +#!chezscheme +;;; Tests for record-writer integration on persistent collections. +;;; Phase 26 of Round 4. +;;; +;;; Contract: +;;; pmap prints as {k1 v1 k2 v2} (no commas, matches Clojure sans :) +;;; pvec prints as [e1 e2 e3] (square brackets distinguish from #(...)) +;;; pset prints as #{e1 e2 e3} (matches Clojure set literal) +;;; +;;; Element order for pmap/pset follows internal iteration order, which +;;; is a function of hash layout — not insertion order. Tests avoid +;;; depending on order for multi-element collections. + +(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)))))])) + +(define (->str proc obj) + (with-output-to-string (lambda () (proc obj)))) + +(printf "--- Round 4 Phase 26: printers ---~%~%") + +;;; ========== pmap ========== + +(test "pmap empty" (->str display (make-persistent-map)) "{}") + +(test "pmap single" + (->str display (make-persistent-map 'a 1)) + "{a 1}") + +(test "pmap size 2" + ;; Must parse back to the exact map, regardless of hash order. + (let ([s (->str display (make-persistent-map 'a 1 'b 2))]) + (or (equal? s "{a 1 b 2}") (equal? s "{b 2 a 1}"))) + #t) + +(test "pmap write strings quotes" + (->str write (make-persistent-map "k" "v")) + "{\"k\" \"v\"}") + +;;; ========== pvec ========== + +(test "pvec empty" (->str display (persistent-vector)) "[]") +(test "pvec single" (->str display (persistent-vector 42)) "[42]") +(test "pvec ordered" (->str display (persistent-vector 1 2 3)) "[1 2 3]") +(test "pvec write strings" + (->str write (persistent-vector "a" "b")) + "[\"a\" \"b\"]") + +(test "pvec large retains order" + (->str display (list->persistent-vector (iota 10))) + "[0 1 2 3 4 5 6 7 8 9]") + +;;; ========== pset ========== + +(test "pset empty" (->str display (make-persistent-set)) "#{}") +(test "pset single" (->str display (make-persistent-set 'a)) "#{a}") + +;;; ========== nesting ========== + +(test "pvec of pmap" + (->str display (persistent-vector (make-persistent-map 'x 1))) + "[{x 1}]") + +(test "pmap with pvec value" + (->str display (make-persistent-map 'lst (persistent-vector 1 2 3))) + "{lst [1 2 3]}") + +(test "pmap with pset value" + (->str display (make-persistent-map 'tags (make-persistent-set 'a))) + "{tags #{a}}") + +(printf "~%--- Results: ~a/~a passed, ~a failed ---~%" + pass (+ pass fail) fail) + +(exit (if (= fail 0) 0 1))