Add structural equality, hashing, and iterators for pmap/pset
ober
cac604b00c19e053acb6dc04d953daeae4f93d6c
--- a/lib/std/clojure.sls +++ b/lib/std/clojure.sls @@ -43,6 +43,7 @@ first rest next last conj cons* empty? reduce into range + seq =? hash inc dec nil? some? true? false? @@ -66,7 +67,13 @@ ;; ---- Re-exports from (std immutable) ---- imap imap-set imap-ref imap-has? + imap=? imap-hash + in-imap in-imap-pairs in-imap-keys in-imap-values ivec ivec-set ivec-ref ivec-length + ;; ---- Re-exports from (std pset) ---- + persistent-set persistent-set? + persistent-set-contains? persistent-set->list + persistent-set-hash in-pset ;; ---- Re-exports from (std misc atom) ---- atom atom? deref reset! swap! compare-and-set! @@ -481,6 +488,72 @@ [else (error 'into "unsupported to-coll" to-coll)])) ;; ========================================================================= + ;; seq — polymorphic sequence view of a collection. + ;; + ;; Clojure's (seq coll) returns nil for empty collections and a + ;; sequence of elements otherwise. We model Clojure's nil as #f. + ;; - Maps yield (key . val) pairs (matching Clojure's MapEntry). + ;; - Sets yield the elements in HAMT order. + ;; - Vectors and strings yield elements left-to-right. + ;; - Lists return themselves. + ;; ========================================================================= + + (define (seq coll) + (cond + [(eq? coll #f) #f] + [(null? coll) #f] + [(pair? coll) coll] + [(persistent-map? coll) + (if (zero? (persistent-map-size coll)) #f (persistent-map->list coll))] + [(persistent-set? coll) + (if (zero? (persistent-set-size coll)) #f (persistent-set->list coll))] + [(concurrent-hash? coll) + (if (zero? (concurrent-hash-size coll)) + #f + ;; Return (k . v) pairs, matching map semantics. + (let ([ks (concurrent-hash-keys coll)]) + (map (lambda (k) (cons k (concurrent-hash-get coll k))) ks)))] + [(hash-table? coll) + (if (zero? (hash-length coll)) #f (hash->list coll))] + [(vector? coll) + (if (zero? (vector-length coll)) #f (vector->list coll))] + [(string? coll) + (if (zero? (string-length coll)) #f (string->list coll))] + [else (error 'seq "unsupported collection type" coll)])) + + ;; ========================================================================= + ;; Equality and hash — polymorphic wrappers. + ;; + ;; Clojure's (= a b) is structural; Chez's equal? already does the + ;; right thing for lists, vectors, strings, and numbers, but records + ;; (including %pmap / %pset) compare with eq? by default. We dispatch + ;; on the collection type so the specialized =/hash implementations + ;; are used transparently. + ;; ========================================================================= + + (define =? + (case-lambda + [(a) #t] + [(a b) + (cond + [(and (persistent-map? a) (persistent-map? b)) (persistent-map=? a b)] + [(and (persistent-set? a) (persistent-set? b)) (persistent-set=? a b)] + [else (equal? a b)])] + [(a b . more) + (and (=? a b) + (let loop ([x b] [rest more]) + (cond + [(null? rest) #t] + [else (and (=? x (car rest)) (loop (car rest) (cdr rest)))])))])) + + (define (hash x) + ;; Polymorphic structural hash, consistent with =?. + (cond + [(persistent-map? x) (persistent-map-hash x)] + [(persistent-set? x) (persistent-set-hash x)] + [else (equal-hash x)])) + + ;; ========================================================================= ;; Printing ;; ========================================================================= --- a/lib/std/immutable.sls +++ b/lib/std/immutable.sls @@ -37,6 +37,8 @@ imap-fold imap-filter imap-merge + imap=? imap-hash + in-imap in-imap-pairs in-imap-keys in-imap-values ;; Transient imap — mutable builder for bulk construction imap-transient imap-transient? @@ -113,6 +115,12 @@ (define imap-fold persistent-map-fold) (define imap-filter persistent-map-filter) (define imap-merge persistent-map-merge) + (define imap=? persistent-map=?) + (define imap-hash persistent-map-hash) + (define in-imap in-pmap) + (define in-imap-pairs in-pmap-pairs) + (define in-imap-keys in-pmap-keys) + (define in-imap-values in-pmap-values) (define (hashtable->imap ht) ;; Convert a mutable hashtable to an immutable map. --- a/lib/std/pmap.sls +++ b/lib/std/pmap.sls @@ -25,6 +25,10 @@ persistent-map->list persistent-map-keys persistent-map-values persistent-map-for-each persistent-map-map persistent-map-fold persistent-map-filter + ;; Structural equality / hashing + persistent-map=? persistent-map-hash + ;; Iterators (return lists compatible with std/iter's for/for/collect) + in-pmap in-pmap-pairs in-pmap-keys in-pmap-values ;; Merge / set operations persistent-map-merge persistent-map-diff ;; Transients — mutable, faster for bulk construction @@ -413,6 +417,121 @@ (lambda (k v) (not (persistent-map-has? m2 k))) m1)) + ;;; ========== Structural equality ========== + ;; + ;; Two persistent maps are equal iff they have the same size AND + ;; every (key, value) pair in m1 is also present in m2 (with a + ;; value that equal?'s). Size check is O(1); the membership walk + ;; is O(n * log_32 n) ≈ O(n). Short-circuits on first mismatch via + ;; an internal escape continuation. + ;; + ;; Does NOT require key order to match — HAMT iteration order is + ;; a function of hash layout, not insertion order, so ordering is + ;; not part of the value-equality contract. + ;; + ;; Values are compared with a recursive helper `pmap-val=?` so that + ;; nested persistent maps compare structurally rather than by eq? + ;; (Chez's equal? does not understand user-defined record types). + + (define (pmap-val=? a b) + (cond + [(and (%pmap? a) (%pmap? b)) (persistent-map=? a b)] + [(and (pair? a) (pair? b)) + (and (pmap-val=? (car a) (car b)) + (pmap-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] + [(pmap-val=? (vector-ref a i) (vector-ref b i)) + (loop (+ i 1))] + [else #f]))))] + [else (equal? a b)])) + + (define (persistent-map=? m1 m2) + (cond + [(eq? m1 m2) #t] + [(not (%pmap? m1)) #f] + [(not (%pmap? m2)) #f] + [(not (= (%pmap-size m1) (%pmap-size m2))) #f] + [else + (call/cc + (lambda (return) + (persistent-map-for-each + (lambda (k v) + (let ([result (hamt-ref (%pmap-root m2) k + ((%pmap-hash-proc m2) k) + 0 (%pmap-equal-proc m2))]) + (unless (and result (pmap-val=? (cdr result) v)) + (return #f)))) + m1) + #t))])) + + ;;; ========== Structural hash ========== + ;; + ;; Order-independent hash: combine per-entry hashes with XOR so + ;; rearranging entries yields the same map-hash. Each entry is + ;; hashed as (pmap-val-hash k) xor (pmap-val-hash v) which mixes + ;; key and value. Uses a recursive helper that understands nested + ;; %pmap values, so the invariant + ;; (=> (persistent-map=? m1 m2) (= (persistent-map-hash m1) + ;; (persistent-map-hash m2))) + ;; holds even for maps whose values are themselves %pmap records + ;; (which Chez's equal-hash compares by identity). + + (define (pmap-val-hash x) + (cond + [(%pmap? x) (persistent-map-hash x)] + [(pair? x) + ;; Cheap mixing — sensitive to position so (a . b) and (b . a) + ;; don't collide, but still deterministic for equal values. + (bitwise-xor (pmap-val-hash (car x)) + (bitwise-arithmetic-shift (pmap-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 + (pmap-val-hash (vector-ref x i)) 3))))))] + [else (equal-hash x)])) + + (define (persistent-map-hash m) + (let ([h 0]) + (persistent-map-for-each + (lambda (k v) + ;; Combine k and v with a non-linear mix so swapping + ;; two entries' halves can't alias in the global XOR. + (set! h (bitwise-xor h + (bitwise-xor (pmap-val-hash k) + (bitwise-arithmetic-shift (pmap-val-hash v) 1))))) + m) + ;; Mix size in so empty vs. full-of-zeros don't collide. + (bitwise-xor h (equal-hash (%pmap-size m))))) + + ;;; ========== Iterators ========== + ;; + ;; (std iter)'s for/for-collect/for/fold walk plain lists, so each + ;; iterator here materializes the map into a list. This matches the + ;; existing in-hash-keys / in-hash-values / in-hash-pairs pattern. + + (define (in-pmap-keys m) + (persistent-map-keys m)) + + (define (in-pmap-values m) + (persistent-map-values m)) + + (define (in-pmap-pairs m) + (persistent-map->list m)) + + ;; `in-pmap` — default iterator yields (key . val) pairs, matching + ;; Clojure's (for [[k v] m] ...) idiom once users destructure. + (define in-pmap in-pmap-pairs) + ;;; ========== Transients ========== ;; ;; A transient-map is a mutable wrapper around a HAMT root that --- a/lib/std/pset.sls +++ b/lib/std/pset.sls @@ -55,6 +55,8 @@ pset-union pset-intersection pset-difference persistent-set-subset? pset-subset? persistent-set=? pset=? + persistent-set-hash pset-hash + in-pset ;; Transient variant for bulk construction transient-set transient-set? tset-add! tset-remove! tset-contains? tset-size @@ -187,11 +189,25 @@ (and (= (persistent-set-size s1) (persistent-set-size s2)) (persistent-set-subset? s1 s2))) + ;; Order-independent structural hash. Mirrors persistent-map-hash + ;; but only consumes the keys (values are always the sentinel #t). + (define (persistent-set-hash s) + (let ([h 0]) + (persistent-set-for-each + (lambda (x) (set! h (bitwise-xor h (equal-hash x)))) + s) + (bitwise-xor h (equal-hash (persistent-set-size s))))) + + ;; Iterator — returns a list of elements, compatible with (std iter). + (define (in-pset s) + (persistent-set->list s)) + (define pset-union persistent-set-union) (define pset-intersection persistent-set-intersection) (define pset-difference persistent-set-difference) (define pset-subset? persistent-set-subset?) (define pset=? persistent-set=?) + (define pset-hash persistent-set-hash) ;;; ========== Transients (set variant) ========== ;; --- a/tests/test-pmap.ss +++ b/tests/test-pmap.ss @@ -212,6 +212,101 @@ (persistent-map-has? m3 'c))) '(2 #t #f #t)) +;;; ======== Structural equality ======== + +(test "=? identical" + (let ([m (persistent-map 'a 1 'b 2)]) + (persistent-map=? m m)) + #t) + +(test "=? same content different order" + (persistent-map=? + (persistent-map 'a 1 'b 2 'c 3) + (persistent-map 'c 3 'b 2 'a 1)) + #t) + +(test "=? different sizes" + (persistent-map=? + (persistent-map 'a 1 'b 2) + (persistent-map 'a 1)) + #f) + +(test "=? same size different keys" + (persistent-map=? + (persistent-map 'a 1 'b 2) + (persistent-map 'a 1 'c 2)) + #f) + +(test "=? same keys different values" + (persistent-map=? + (persistent-map 'a 1 'b 2) + (persistent-map 'a 1 'b 99)) + #f) + +(test "=? nested equal" + (persistent-map=? + (persistent-map 'a (persistent-map 'x 1)) + (persistent-map 'a (persistent-map 'x 1))) + #t) + +(test "=? empty maps" + (persistent-map=? pmap-empty pmap-empty) + #t) + +(test "=? non-pmap → #f" + (persistent-map=? (persistent-map 'a 1) '((a . 1))) + #f) + +;;; ======== Structural hash ======== + +(test "hash equal when content matches (different insertion order)" + (= (persistent-map-hash (persistent-map 'a 1 'b 2 'c 3)) + (persistent-map-hash (persistent-map 'c 3 'b 2 'a 1))) + #t) + +(test "hash differs for different content" + (not (= (persistent-map-hash (persistent-map 'a 1)) + (persistent-map-hash (persistent-map 'a 2)))) + #t) + +(test "hash is integer" + (integer? (persistent-map-hash (persistent-map 'a 1 'b 2))) + #t) + +(test "hash empty map" + (integer? (persistent-map-hash pmap-empty)) + #t) + +(test "hash respects nested pmap equality" + (= (persistent-map-hash (persistent-map 'a (persistent-map 'x 1))) + (persistent-map-hash (persistent-map 'a (persistent-map 'x 1)))) + #t) + +;;; ======== Iterators ======== + +(test "in-pmap-keys returns a list" + (list? (in-pmap-keys (persistent-map 'a 1 'b 2))) + #t) + +(test "in-pmap-keys has all keys" + (let ([ks (sort (lambda (a b) (string<? (symbol->string a) + (symbol->string b))) + (in-pmap-keys (persistent-map 'a 1 'b 2 'c 3)))]) + ks) + '(a b c)) + +(test "in-pmap-values sum" + (apply + (in-pmap-values (persistent-map 'a 1 'b 2 'c 3))) + 6) + +(test "in-pmap-pairs count" + (length (in-pmap-pairs (persistent-map 'a 1 'b 2))) + 2) + +(test "in-pmap default is pairs" + (length (in-pmap (persistent-map 'a 1 'b 2 'c 3))) + 3) + ;;; Summary (printf "~%Persistent Hash Maps: ~a passed, ~a failed~%" pass fail) new file mode 100644 --- /dev/null +++ b/tests/test-pset.ss @@ -0,0 +1,208 @@ +#!chezscheme +;;; Tests for (std pset) -- Persistent Hash Sets +;;; +;;; Covers construction, membership, set ops, structural equality, +;;; hashing, and iterators. + +(import (chezscheme) + (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 "--- Persistent Hash Sets ---~%~%") + +;;; ======== Construction & membership ======== + +(test "empty set size" + (persistent-set-size pset-empty) + 0) + +(test "empty predicate" + (persistent-set? pset-empty) + #t) + +(test "non-set predicate" + (persistent-set? '(1 2 3)) + #f) + +(test "from items" + (persistent-set-size (persistent-set 1 2 3 4 5)) + 5) + +(test "duplicates collapsed" + (persistent-set-size (persistent-set 1 2 1 3 2 1)) + 3) + +(test "contains? hit" + (persistent-set-contains? (persistent-set 'a 'b 'c) 'b) + #t) + +(test "contains? miss" + (persistent-set-contains? (persistent-set 'a 'b 'c) 'z) + #f) + +;;; ======== Functional update ======== + +(test "add preserves original" + (let* ([s1 (persistent-set 1 2)] + [s2 (persistent-set-add s1 3)]) + (list (persistent-set-size s1) + (persistent-set-size s2) + (persistent-set-contains? s1 3) + (persistent-set-contains? s2 3))) + '(2 3 #f #t)) + +(test "add existing is no-op" + (let* ([s1 (persistent-set 1 2)] + [s2 (persistent-set-add s1 1)]) + (eq? s1 s2)) + #t) + +(test "remove preserves original" + (let* ([s1 (persistent-set 1 2 3)] + [s2 (persistent-set-remove s1 2)]) + (list (persistent-set-size s1) + (persistent-set-size s2) + (persistent-set-contains? s2 2))) + '(3 2 #f)) + +;;; ======== Set operations ======== + +(test "union" + (persistent-set-size + (persistent-set-union (persistent-set 1 2 3) (persistent-set 3 4 5))) + 5) + +(test "intersection" + (let ([s (persistent-set-intersection + (persistent-set 1 2 3 4) + (persistent-set 3 4 5 6))]) + (list (persistent-set-size s) + (persistent-set-contains? s 3) + (persistent-set-contains? s 4) + (persistent-set-contains? s 1))) + '(2 #t #t #f)) + +(test "difference" + (let ([s (persistent-set-difference + (persistent-set 1 2 3) + (persistent-set 2))]) + (list (persistent-set-size s) + (persistent-set-contains? s 1) + (persistent-set-contains? s 3) + (persistent-set-contains? s 2))) + '(2 #t #t #f)) + +(test "subset?" + (persistent-set-subset? (persistent-set 1 2) (persistent-set 1 2 3)) + #t) + +(test "subset? false" + (persistent-set-subset? (persistent-set 1 2 3) (persistent-set 1 2)) + #f) + +;;; ======== Structural equality ======== + +(test "=? same" + (persistent-set=? (persistent-set 1 2 3) (persistent-set 1 2 3)) + #t) + +(test "=? reordered" + (persistent-set=? (persistent-set 1 2 3) (persistent-set 3 2 1)) + #t) + +(test "=? different size" + (persistent-set=? (persistent-set 1 2) (persistent-set 1 2 3)) + #f) + +(test "=? different elements" + (persistent-set=? (persistent-set 1 2 3) (persistent-set 1 2 4)) + #f) + +(test "=? empty" + (persistent-set=? pset-empty pset-empty) + #t) + +;;; ======== Structural hash ======== + +(test "hash reordered equal" + (= (persistent-set-hash (persistent-set 1 2 3)) + (persistent-set-hash (persistent-set 3 2 1))) + #t) + +(test "hash different differs" + (not (= (persistent-set-hash (persistent-set 1 2)) + (persistent-set-hash (persistent-set 1 3)))) + #t) + +(test "hash empty is integer" + (integer? (persistent-set-hash pset-empty)) + #t) + +;;; ======== Iteration ======== + +(test "->list count" + (length (persistent-set->list (persistent-set 'a 'b 'c 'd))) + 4) + +(test "fold sum" + (persistent-set-fold + 0 (persistent-set 1 2 3 4 5)) + 15) + +(test "filter" + (let ([s (persistent-set-filter even? (persistent-set 1 2 3 4 5))]) + (list (persistent-set-size s) + (persistent-set-contains? s 2) + (persistent-set-contains? s 4) + (persistent-set-contains? s 1))) + '(2 #t #t #f)) + +(test "map" + (let ([s (persistent-set-map (lambda (x) (* x x)) + (persistent-set 1 2 3))]) + (list (persistent-set-size s) + (persistent-set-contains? s 1) + (persistent-set-contains? s 4) + (persistent-set-contains? s 9))) + '(3 #t #t #t)) + +(test "in-pset iterator" + (length (in-pset (persistent-set 'a 'b 'c))) + 3) + +;;; ======== Transients ======== + +(test "transient bulk insert" + (let ([t (transient-set pset-empty)]) + (tset-add! t 1) + (tset-add! t 2) + (tset-add! t 3) + (persistent-set-size (persistent-set! t))) + 3) + +(test "transient size tracking" + (let ([t (transient-set pset-empty)]) + (tset-add! t 1) + (tset-add! t 1) + (tset-add! t 2) + (tset-size t)) + 2) + +;;; Summary + +(printf "~%Persistent Hash Sets: ~a passed, ~a failed~%" pass fail) +(when (> fail 0) + (exit 1))