1#lang racket/base
2(require (for-syntax racket/base))
3
4;; Lightweight variant of sets
5
6(provide set seteq seteqv
7         set?
8         set-empty?
9         set-member?
10         set-count
11         set-add
12         set-remove
13         set-first
14         subset?
15         set=?
16         set-subtract
17         set-union
18         set-intersect
19         set-partition
20         set->list
21         list->set
22         list->seteq
23         for/set
24         for/seteq
25         for/seteqv
26         for*/set
27         for*/seteq
28         in-set)
29
30(define the-empty-hash #hash())
31(define the-empty-hasheq #hasheq())
32(define the-empty-hasheqv #hasheqv())
33
34(define set
35  (case-lambda
36    [() the-empty-hash]
37    [l (for/fold ([s the-empty-hash]) ([e (in-list l)])
38         (hash-set s e #t))]))
39(define seteq
40  (case-lambda
41    [() the-empty-hasheq]
42    [l (for/fold ([s the-empty-hasheq]) ([e (in-list l)])
43         (hash-set s e #t))]))
44(define (seteqv) the-empty-hasheqv)
45
46(define (set? s) (hash? s))
47
48(define (set-empty? s) (zero? (hash-count s)))
49(define (set-member? s e) (hash-ref s e #f))
50(define (set-count s) (hash-count s))
51
52(define (set-add s e) (hash-set s e #t))
53(define (set-remove s e) (hash-remove s e))
54(define (set-first s) (hash-iterate-key s (hash-iterate-first s)))
55
56(define-syntax in-set (make-rename-transformer #'in-immutable-hash-keys))
57
58(define (subset? s1 s2)
59  (hash-keys-subset? s1 s2))
60
61(define (set=? s1 s2)
62  (or (eq? s1 s2)
63      (and (= (hash-count s1) (hash-count s2))
64           (hash-keys-subset? s1 s2))))
65
66(define (set-subtract s1 s2)
67  (for/fold ([s1 s1]) ([k (in-set s2)])
68    (hash-remove s1 k)))
69
70(define (set-union s1 s2)
71  (if ((set-count s1) . < . (set-count s2))
72      (set-union s2 s1)
73      (for/fold ([s1 s1]) ([k (in-set s2)])
74        (hash-set s1 k #t))))
75
76(define (set-intersect s1 s2)
77  (if ((set-count s1) . < . (set-count s2))
78      (set-intersect s2 s1)
79      (for/fold ([s s2]) ([k (in-set s2)])
80        (if (hash-ref s1 k #f)
81            s
82            (hash-remove s k)))))
83
84(define (set-partition s pred empty-y-set empty-n-set)
85  (for/fold ([y empty-y-set] [n empty-n-set]) ([v (in-set s)])
86    (if (pred v)
87        (values (set-add y v) n)
88        (values y (set-add n v)))))
89
90(define (set->list s)
91  (for/list ([k (in-set s)])
92    k))
93
94(define (list->set l)
95  (for/set ([k (in-list l)])
96    k))
97
98(define (list->seteq l)
99  (for/seteq ([k (in-list l)])
100    k))
101
102(define-syntax-rule (for/set bindings body ...)
103  (for/hash bindings (values
104                      (let ()
105                        body ...)
106                      #t)))
107
108(define-syntax-rule (for/seteq bindings body ...)
109  (for/hasheq bindings (values
110                        (let ()
111                          body ...)
112                        #t)))
113
114(define-syntax-rule (for/seteqv bindings body ...)
115  (for/hasheqv bindings (values
116                         (let ()
117                           body ...)
118                         #t)))
119
120(define-syntax-rule (for*/set bindings body ...)
121  (for*/hash bindings (values
122                       (let ()
123                         body ...)
124                       #t)))
125
126(define-syntax-rule (for*/seteq bindings body ...)
127  (for*/hasheq bindings (values
128                         (let ()
129                           body ...)
130                         #t)))
131