suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Renamed make-set{,eq,eqv} to set{,eq,eqv} for uniformity with list, vector, etc.

Browse Source 
svn: r18338
This commit is contained in:
Carl Eastlund 2010-02-25 19:46:36 +00:00
parent 2f6c2377f9
commit 8b93f081bc
3 changed files with 72 additions and 69 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
collects/scheme/set.ss
View File

@ -1,9 +1,8 @@
#lang scheme/base
(require (for-syntax scheme/base))
(provide (rename-out [make-set* make-set])
make-seteq make-seteqv
set? set-eq? set-eqv?
(provide set seteq seteqv
set? set-eq? set-eqv? set-equal?
set-empty? set-count
set-member? set-add set-remove
set-union set-intersect set-subtract
@ -11,6 +10,7 @@
(rename-out [*in-set in-set]))
(define-struct set (ht)
#:omit-define-syntaxes
#:property prop:equal+hash (list
(lambda (set1 set2 =?)
(=? (set-ht set1) (set-ht set2)))
@ -18,13 +18,11 @@
(lambda (set hc) (add1 (hc (set-ht set)))))
#:property prop:sequence (lambda (v) (*in-set v)))
(define make-set*
(let ([make-set (lambda elems
(make-set (make-immutable-hash (map (lambda (k) (cons k #t)) elems))))])
make-set))
(define (make-seteq . elems)
(define (set . elems)
(make-set (make-immutable-hash (map (lambda (k) (cons k #t)) elems))))
(define (seteq . elems)
(make-set (make-immutable-hasheq (map (lambda (k) (cons k #t)) elems))))
(define (make-seteqv . elems)
(define (seteqv . elems)
(make-set (make-immutable-hasheqv (map (lambda (k) (cons k #t)) elems))))
(define (set-eq? set)
@ -33,6 +31,11 @@
(define (set-eqv? set)
(unless (set? set) (raise-type-error 'set-eqv? "set" 0 set))
(hash-eqv? (set-ht set)))
(define (set-equal? set)
(unless (set? set) (raise-type-error 'set-equal? "set" 0 set))
(let* ([ht (set-ht set)])
(not (or (hash-eq? ht)
(hash-eqv? ht)))))
(define (set-empty? set)
(unless (set? set) (raise-type-error 'set-empty? "set" 0 set))

6
collects/scribblings/reference/sets.scrbl
View File

@ -36,9 +36,9 @@ Returns @scheme[#t] if @scheme[set] compares elements with @scheme[eq?],
@scheme[#f] if it compares with @scheme[equal?] or @scheme[eqv?].}
@deftogether[(
@defproc[(make-set [v any/c] ...) set?]
@defproc[(make-seteqv [v any/c] ...) set?]
@defproc[(make-seteq [v any/c] ...) set?]
@defproc[(set [v any/c] ...) set?]
@defproc[(seteqv [v any/c] ...) set?]
@defproc[(seteq [v any/c] ...) set?]
)]{
Creates a set that uses @scheme[equal?], @scheme[eq?], or

114
collects/tests/mzscheme/set.ss
View File

@ -5,43 +5,43 @@
;; ----------------------------------------
(test #t set? (make-set))
(test #t set-empty? (make-set))
(test #t set? (make-set 1 2 3))
(test #f set-empty? (make-set 1 2 3))
(test #t set? (make-seteq))
(test #t set-empty? (make-seteq))
(test #t set? (make-seteq 1 2 3))
(test #f set-empty? (make-seteq 1 2 3))
(test #t set? (make-seteqv))
(test #t set-empty? (make-seteqv))
(test #t set? (make-seteqv 1 2 3))
(test #f set-empty? (make-seteqv 1 2 3))
(test #t set? (set))
(test #t set-empty? (set))
(test #t set? (set 1 2 3))
(test #f set-empty? (set 1 2 3))
(test #t set? (seteq))
(test #t set-empty? (seteq))
(test #t set? (seteq 1 2 3))
(test #f set-empty? (seteq 1 2 3))
(test #t set? (seteqv))
(test #t set-empty? (seteqv))
(test #t set? (seteqv 1 2 3))
(test #f set-empty? (seteqv 1 2 3))
(test #f set-eq? (make-set 1 2 3))
(test #f set-eqv? (make-set 1 2 3))
(test #t set-eq? (make-seteq 1 2 3))
(test #f set-eqv? (make-seteq 1 2 3))
(test #f set-eq? (make-seteqv 1 2 3))
(test #t set-eqv? (make-seteqv 1 2 3))
(test #f set-eq? (set 1 2 3))
(test #f set-eqv? (set 1 2 3))
(test #t set-eq? (seteq 1 2 3))
(test #f set-eqv? (seteq 1 2 3))
(test #f set-eq? (seteqv 1 2 3))
(test #t set-eqv? (seteqv 1 2 3))
(test 3 set-count (make-set (string #\a) "b" "c" (string #\a)))
(test 4 set-count (make-seteqv (string #\a) "b" "c" (string #\a)))
(test 4 set-count (make-seteq (string #\a) "b" "c" (string #\a)))
(test 3 set-count (set (string #\a) "b" "c" (string #\a)))
(test 4 set-count (seteqv (string #\a) "b" "c" (string #\a)))
(test 4 set-count (seteq (string #\a) "b" "c" (string #\a)))
(test #t set-member? (make-set 1 2 3) 1)
(test #t set-member? (make-set 1 2 3) 2)
(test #t set-member? (make-set 1 2 3) 3)
(test #f set-member? (make-set 1 2 3) 4)
(test #t set-member? (set 1 2 3) 1)
(test #t set-member? (set 1 2 3) 2)
(test #t set-member? (set 1 2 3) 3)
(test #f set-member? (set 1 2 3) 4)
(let ([s (make-set 1 2 3)])
(test #t equal? s (set-add (set-add (set-add (make-set) 1) 2) 3))
(test #t equal? (make-seteq 1 2 3) (make-seteq 1 2 3))
(test #t equal? (make-seteq 1 2 3) (make-seteq 3 2 1))
(test #t equal? (make-seteqv 1 2 3) (make-seteqv 1 2 3))
(test #f equal? s (make-seteq 1 2 3))
(test #f equal? s (make-seteqv 1 2 3))
(test #f equal? (make-seteq 1 2 3) (make-seteqv 1 2 3))
(let ([s (set 1 2 3)])
(test #t equal? s (set-add (set-add (set-add (set) 1) 2) 3))
(test #t equal? (seteq 1 2 3) (seteq 1 2 3))
(test #t equal? (seteq 1 2 3) (seteq 3 2 1))
(test #t equal? (seteqv 1 2 3) (seteqv 1 2 3))
(test #f equal? s (seteq 1 2 3))
(test #f equal? s (seteqv 1 2 3))
(test #f equal? (seteq 1 2 3) (seteqv 1 2 3))
(test #t set-member? (set-add s 5) 3)
(test #t set-member? (set-add s 5) 5)
@ -51,37 +51,37 @@
(test #f set-member? (set-remove s 3) 3)
(test 3 set-count (set-union s))
(test 6 set-count (set-union s (make-set 3 4 5 6)))
(test 6 set-count (set-union (make-set 3 4 5 6) s))
(test 8 set-count (set-union (make-set 3 4 5 6) s (make-set 1 10 100)))
(test 6 set-count (set-union s (set 3 4 5 6)))
(test 6 set-count (set-union (set 3 4 5 6) s))
(test 8 set-count (set-union (set 3 4 5 6) s (set 1 10 100)))
(test (make-seteq 1 2 3) set-union (make-seteq 1 2) (make-seteq 3))
(test (make-seteqv 1 2 3) set-union (make-seteqv 1 2) (make-seteqv 3))
(test (seteq 1 2 3) set-union (seteq 1 2) (seteq 3))
(test (seteqv 1 2 3) set-union (seteqv 1 2) (seteqv 3))
(test s set-intersect s)
(test (make-set 3) set-intersect s (make-set 5 4 3 6))
(test (make-set 3) set-intersect (make-set 5 4 3 6) s)
(test (make-seteq 3) set-intersect (make-seteq 5 4 3 6) (make-seteq 1 2 3))
(test (make-seteqv 3) set-intersect (make-seteqv 5 4 3 6) (make-seteqv 1 2 3))
(test (make-set 3 2) set-intersect s (make-set 5 2 3))
(test (make-seteq 3 2) set-intersect (make-seteq 1 2 3) (make-seteq 5 2 3))
(test (make-set 2) set-intersect s (make-set 5 2 3) (make-set 2 20 200))
(test (make-seteq 2) set-intersect (make-seteq 1 2 3) (make-seteq 5 2 3) (make-seteq 2 20 200))
(test (set 3) set-intersect s (set 5 4 3 6))
(test (set 3) set-intersect (set 5 4 3 6) s)
(test (seteq 3) set-intersect (seteq 5 4 3 6) (seteq 1 2 3))
(test (seteqv 3) set-intersect (seteqv 5 4 3 6) (seteqv 1 2 3))
(test (set 3 2) set-intersect s (set 5 2 3))
(test (seteq 3 2) set-intersect (seteq 1 2 3) (seteq 5 2 3))
(test (set 2) set-intersect s (set 5 2 3) (set 2 20 200))
(test (seteq 2) set-intersect (seteq 1 2 3) (seteq 5 2 3) (seteq 2 20 200))
(test s set-subtract s)
(test (make-set) set-subtract s s)
(test s set-subtract s (make-set 100))
(test (make-set 1 3) set-subtract s (make-set 2 100))
(test (make-seteq 100) set-subtract (make-seteq 2 100) (make-seteq 1 2 3))
(test (make-seteq 9 100) set-subtract (make-seteq 2 100 1000 9) (make-seteq 1 2 3) (make-seteq 1000 5))
(test (set) set-subtract s s)
(test s set-subtract s (set 100))
(test (set 1 3) set-subtract s (set 2 100))
(test (seteq 100) set-subtract (seteq 2 100) (seteq 1 2 3))
(test (seteq 9 100) set-subtract (seteq 2 100 1000 9) (seteq 1 2 3) (seteq 1000 5))
(let ([try-mismatch (lambda (set-op)
(err/rt-test (set-op (make-seteqv 1 2) (make-set 3)))
(err/rt-test (set-op (make-seteqv 1 2) (make-seteq 3)))
(err/rt-test (set-op (make-set 1 2) (make-seteq 3)))
(err/rt-test (set-op (make-set 1 2) (make-set 4) (make-seteq 3)))
(err/rt-test (set-op (make-set 1 2) (make-seteq 3) (make-set 4)))
(err/rt-test (set-op (make-seteq 3) (make-set 1 2) (make-set 4))))])
(err/rt-test (set-op (seteqv 1 2) (set 3)))
(err/rt-test (set-op (seteqv 1 2) (seteq 3)))
(err/rt-test (set-op (set 1 2) (seteq 3)))
(err/rt-test (set-op (set 1 2) (set 4) (seteq 3)))
(err/rt-test (set-op (set 1 2) (seteq 3) (set 4)))
(err/rt-test (set-op (seteq 3) (set 1 2) (set 4))))])
(try-mismatch set-union)
(try-mismatch set-intersect)
(try-mismatch set-subtract))