Add (std pset) persistent sets and Clojure set API to (std clojure)
ober
e7a158d0c7a1e193dc210f48ab23a1b82895f6ed
--- a/lib/std/clojure.sls +++ b/lib/std/clojure.sls @@ -50,9 +50,14 @@ transient persistent! transient? assoc! dissoc! conj! + ;; ---- Sets ---- + hash-set set set? + disj + union intersection difference subset? superset? + ;; ---- Constructors (aliases) ---- hash-map vec list* vector* - hash-set make-hash-set + make-hash-set ;; The prelude's mutable hash-table can still be constructed ;; with make-hash-table. @@ -85,6 +90,8 @@ (transient-set! pvec-t-set!) (transient-ref pvec-t-ref) (transient-append! pvec-t-append!)) + (rename (std pset) + (persistent-set! pset-persistent!)) (std concur hash) (std misc atom) (std misc nested)) @@ -113,6 +120,7 @@ [(null? coll) #t] [(pair? coll) #f] [(persistent-map? coll) (zero? (persistent-map-size coll))] + [(persistent-set? coll) (zero? (persistent-set-size coll))] [(concurrent-hash? coll) (zero? (concurrent-hash-size coll))] [(hash-table? coll) (zero? (hash-length coll))] [(vector? coll) (zero? (vector-length coll))] @@ -128,6 +136,7 @@ [(null? coll) 0] [(pair? coll) (length coll)] [(persistent-map? coll) (persistent-map-size coll)] + [(persistent-set? coll) (persistent-set-size coll)] [(concurrent-hash? coll) (concurrent-hash-size coll)] [(hash-table? coll) (hash-length coll)] [(vector? coll) (vector-length coll)] @@ -140,12 +149,18 @@ (define get (case-lambda - [(coll key) (nested-get coll key #f)] - [(coll key default) (nested-get coll key default)])) + [(coll key) (get coll key #f)] + [(coll key default) + (cond + ;; Sets: membership check — return `key` if present + [(persistent-set? coll) + (if (persistent-set-contains? coll key) key default)] + [else (nested-get coll key default)])])) (define (contains? coll key) (cond [(persistent-map? coll) (persistent-map-has? coll key)] + [(persistent-set? coll) (persistent-set-contains? coll key)] [(concurrent-hash? coll) (concurrent-hash-key? coll key)] [(hash-table? coll) (hash-key? coll key)] [(vector? coll) @@ -377,6 +392,10 @@ (cdr rest))] [else (error 'conj "cannot conj non-pair onto map" entry)]))))] + [(persistent-set? coll) + (let loop ([s coll] [rest xs]) + (if (null? rest) s + (loop (persistent-set-add s (car rest)) (cdr rest))))] [else (error 'conj "unsupported collection type" coll)])) ;; cons* — Chez's built-in cons* has identical semantics to Clojure's list*: @@ -509,16 +528,18 @@ (cond [(persistent-map? coll) (transient-map coll)] [(persistent-vector? coll) (pvec-transient coll)] + [(persistent-set? coll) (transient-set coll)] [else (error 'transient - "expected a persistent map or vector" coll)])) + "expected a persistent map, vector, or set" coll)])) (define (transient? x) - (or (transient-map? x) (pvec-transient? x))) + (or (transient-map? x) (pvec-transient? x) (transient-set? x))) (define (persistent! t) (cond [(transient-map? t) (persistent-map! t)] [(pvec-transient? t) (pvec-persistent! t)] + [(transient-set? t) (pset-persistent! t)] [else (error 'persistent! "expected a transient" t)])) (define assoc! @@ -564,6 +585,9 @@ [else (error 'conj! "cannot conj non-pair onto transient map" entry)])) xs) t] + [(transient-set? t) + (for-each (lambda (x) (tset-add! t x)) xs) + t] [else (error 'conj! "expected a transient" t)])) ;; ========================================================================= @@ -591,12 +615,72 @@ ;; vector* — builds a mutable vector (Chez's (vector ...) works too) (define (vector* . args) (apply vector args)) - ;; hash-set / make-hash-set placeholders — will be replaced by (std pset) - ;; once that module lands. For now they use a hash-table with dummy values. - (define (make-hash-set) (make-hash-table)) + ;; ========================================================================= + ;; Sets — Clojure-style persistent set API on top of (std pset) + ;; ========================================================================= + + ;; hash-set — Clojure's #{:a :b :c} constructor (define (hash-set . items) - (let ([h (make-hash-table)]) - (for-each (lambda (x) (hash-put! h x #t)) items) - h)) + (apply persistent-set items)) + + ;; set — alias for hash-set (Clojure has both; `set` also coerces + ;; a collection into a set, which we handle by expanding the arg) + (define set + (case-lambda + [() pset-empty] + [(coll) + (cond + [(null? coll) pset-empty] + [(persistent-set? coll) coll] + [(pair? coll) (apply persistent-set coll)] + [(vector? coll) (apply persistent-set (vector->list coll))] + [(persistent-vector? coll) + (apply persistent-set (persistent-vector->list coll))] + [else (error 'set "unsupported collection" coll)])])) + + (define set? persistent-set?) + + ;; make-hash-set — parameterless constructor + (define (make-hash-set) pset-empty) + + ;; disj — Clojure's "remove from set" + (define (disj s . items) + (cond + [(persistent-set? s) + (let loop ([cur s] [rest items]) + (if (null? rest) cur + (loop (persistent-set-remove cur (car rest)) (cdr rest))))] + [else (error 'disj "expected a persistent set" s)])) + + ;; Clojure's clojure.set/ operations + (define (union . sets) + (cond + [(null? sets) pset-empty] + [(null? (cdr sets)) (car sets)] + [else + (let loop ([acc (car sets)] [rest (cdr sets)]) + (if (null? rest) acc + (loop (persistent-set-union acc (car rest)) (cdr rest))))])) + + (define (intersection . sets) + (cond + [(null? sets) pset-empty] + [(null? (cdr sets)) (car sets)] + [else + (let loop ([acc (car sets)] [rest (cdr sets)]) + (if (null? rest) acc + (loop (persistent-set-intersection acc (car rest)) (cdr rest))))])) + + (define (difference . sets) + (cond + [(null? sets) pset-empty] + [(null? (cdr sets)) (car sets)] + [else + (let loop ([acc (car sets)] [rest (cdr sets)]) + (if (null? rest) acc + (loop (persistent-set-difference acc (car rest)) (cdr rest))))])) + + (define (subset? s1 s2) (persistent-set-subset? s1 s2)) + (define (superset? s1 s2) (persistent-set-subset? s2 s1)) ) ;; end library new file mode 100644 --- /dev/null +++ b/lib/std/pset.sls @@ -0,0 +1,237 @@ +#!chezscheme +;;; (std pset) — Persistent Sets (HAMT-backed) +;;; +;;; Immutable hash sets with structural sharing, built on top of +;;; (std pmap). Element equality follows equal?, hashing uses +;;; equal-hash, matching Clojure's default set semantics. +;;; +;;; A persistent-set is a record wrapper around a %pmap whose keys +;;; are the set elements and whose values are the sentinel #t. The +;;; wrapper exists so that (persistent-set? x) distinguishes sets +;;; from maps, and so set-specific ops like union / intersection +;;; / difference can dispatch cleanly. +;;; +;;; Usage: +;;; (import (std pset)) +;;; +;;; (def s (persistent-set 1 2 3)) +;;; (persistent-set-contains? s 2) ;; => #t +;;; (persistent-set-size s) ;; => 3 +;;; +;;; (def s2 (persistent-set-add s 4)) +;;; (def s3 (persistent-set-remove s 1)) +;;; +;;; (persistent-set-union (persistent-set 1 2) (persistent-set 2 3)) +;;; ;; => #{1 2 3} +;;; +;;; (persistent-set-intersection (persistent-set 1 2 3) (persistent-set 2 3 4)) +;;; ;; => #{2 3} +;;; +;;; (persistent-set-difference (persistent-set 1 2 3) (persistent-set 2)) +;;; ;; => #{1 3} +;;; +;;; Short `pset-` aliases are exported for terseness. + +(library (std pset) + (export + ;; Construction + persistent-set make-persistent-set pset-empty + ;; Type predicate + persistent-set? pset? + ;; Access / membership + persistent-set-contains? persistent-set-size + pset-contains? pset-size + ;; Functional update + persistent-set-add persistent-set-remove + pset-add pset-remove + ;; Conversion / iteration + persistent-set->list pset->list + persistent-set-for-each pset-for-each + persistent-set-fold pset-fold + persistent-set-map pset-map + persistent-set-filter pset-filter + ;; Set operations + persistent-set-union persistent-set-intersection persistent-set-difference + pset-union pset-intersection pset-difference + persistent-set-subset? pset-subset? + persistent-set=? pset=? + ;; Transient variant for bulk construction + transient-set transient-set? + tset-add! tset-remove! tset-contains? tset-size + persistent-set!) + + (import (chezscheme) + (std pmap)) + + ;;; ========== Set record ========== + + (define-record-type %pset + (fields (immutable map))) ;; wraps an underlying %pmap + + (define (persistent-set? x) (%pset? x)) + (define pset? persistent-set?) + + (define pset-empty (make-%pset pmap-empty)) + + (define (make-persistent-set . items) + (let ([t (transient-map pmap-empty)]) + (for-each (lambda (x) (tmap-set! t x #t)) items) + (make-%pset (persistent-map! t)))) + + (define (persistent-set . items) + (apply make-persistent-set items)) + + ;;; ========== Access ========== + + (define (persistent-set-size s) + (persistent-map-size (%pset-map s))) + + (define (persistent-set-contains? s item) + (persistent-map-has? (%pset-map s) item)) + + (define pset-size persistent-set-size) + (define pset-contains? persistent-set-contains?) + + ;;; ========== Functional update ========== + + (define (persistent-set-add s item) + (if (persistent-set-contains? s item) + s + (make-%pset (persistent-map-set (%pset-map s) item #t)))) + + (define (persistent-set-remove s item) + (if (persistent-set-contains? s item) + (make-%pset (persistent-map-delete (%pset-map s) item)) + s)) + + (define pset-add persistent-set-add) + (define pset-remove persistent-set-remove) + + ;;; ========== Iteration ========== + + (define (persistent-set-for-each proc s) + ;; proc: (item) -> unused + (persistent-map-for-each + (lambda (k v) (proc k)) + (%pset-map s))) + + (define (persistent-set->list s) + (persistent-map-keys (%pset-map s))) + + (define (persistent-set-fold proc init s) + ;; proc: (acc item) -> new-acc + (persistent-map-fold + (lambda (acc k v) (proc acc k)) + init + (%pset-map s))) + + (define (persistent-set-map proc s) + ;; proc: (item) -> new-item + (let ([t (transient-map pmap-empty)]) + (persistent-set-for-each + (lambda (x) (tmap-set! t (proc x) #t)) + s) + (make-%pset (persistent-map! t)))) + + (define (persistent-set-filter pred s) + (let ([t (transient-map pmap-empty)]) + (persistent-set-for-each + (lambda (x) (when (pred x) (tmap-set! t x #t))) + s) + (make-%pset (persistent-map! t)))) + + (define pset->list persistent-set->list) + (define pset-for-each persistent-set-for-each) + (define pset-fold persistent-set-fold) + (define pset-map persistent-set-map) + (define pset-filter persistent-set-filter) + + ;;; ========== Set operations ========== + + (define (persistent-set-union s1 s2) + ;; All items in s1 OR s2 + (let ([t (transient-map (%pset-map s1))]) + (persistent-set-for-each + (lambda (x) (tmap-set! t x #t)) + s2) + (make-%pset (persistent-map! t)))) + + (define (persistent-set-intersection s1 s2) + ;; Items present in BOTH + (let ([t (transient-map pmap-empty)] + ;; Iterate the smaller one for efficiency + [smaller (if (< (persistent-set-size s1) (persistent-set-size s2)) s1 s2)] + [larger (if (< (persistent-set-size s1) (persistent-set-size s2)) s2 s1)]) + (persistent-set-for-each + (lambda (x) (when (persistent-set-contains? larger x) (tmap-set! t x #t))) + smaller) + (make-%pset (persistent-map! t)))) + + (define (persistent-set-difference s1 s2) + ;; Items in s1 but not in s2 + (let ([t (transient-map pmap-empty)]) + (persistent-set-for-each + (lambda (x) (unless (persistent-set-contains? s2 x) (tmap-set! t x #t))) + s1) + (make-%pset (persistent-map! t)))) + + (define (persistent-set-subset? s1 s2) + ;; Is every element of s1 also in s2? + (let ([ok #t]) + (persistent-set-for-each + (lambda (x) (when (not (persistent-set-contains? s2 x)) (set! ok #f))) + s1) + ok)) + + (define (persistent-set=? s1 s2) + (and (= (persistent-set-size s1) (persistent-set-size s2)) + (persistent-set-subset? s1 s2))) + + (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=?) + + ;;; ========== Transients (set variant) ========== + ;; + ;; Mirrors tmap for bulk construction — wrap a transient-map whose + ;; keys are the set elements. + + (define-record-type %tset + (fields (immutable tmap))) + + (define (transient-set s) + (cond + [(persistent-set? s) (make-%tset (transient-map (%pset-map s)))] + [else (error 'transient-set "expected a persistent-set" s)])) + + (define (transient-set? x) (%tset? x)) + + (define (tset-check who t) + (unless (%tset? t) + (error who "expected a transient-set" t))) + + (define (tset-add! t item) + (tset-check 'tset-add! t) + (tmap-set! (%tset-tmap t) item #t) + t) + + (define (tset-remove! t item) + (tset-check 'tset-remove! t) + (tmap-delete! (%tset-tmap t) item) + t) + + (define (tset-contains? t item) + (tset-check 'tset-contains? t) + (tmap-has? (%tset-tmap t) item)) + + (define (tset-size t) + (tset-check 'tset-size t) + (tmap-size (%tset-tmap t))) + + (define (persistent-set! t) + (tset-check 'persistent-set! t) + (make-%pset (persistent-map! (%tset-tmap t)))) + +) ;; end library