diff options
Diffstat (limited to '')
-rw-r--r-- | module/hnh/util/set.scm | 46 |
1 files changed, 46 insertions, 0 deletions
diff --git a/module/hnh/util/set.scm b/module/hnh/util/set.scm new file mode 100644 index 00000000..2839a231 --- /dev/null +++ b/module/hnh/util/set.scm @@ -0,0 +1,46 @@ +(define-module (hnh util set) + :use-module (hnh util object) + :use-module (hnh util table)) + +(define-type (set) + (set-data default: (make-table))) + +(define (set-null) (set)) + +(define (set-adjoin value set) + (modify set set-data tree-put value #t)) + +(define (set-disjoin value set) + (modify set set-data tree-put value #f)) + +(define (in-set? set value) + (catch 'out-of-range + (lambda () (tree-get (set-data set) value)) + (lambda () #f))) + +(define (set-fold f done set) + (tree-fold (lambda (k v lst) + (if v + (f k done) + done)) + done set)) + +(define (set->list set) + (set-fold cons '() set)) + +(define (set-union set1 set2) + (set-fold set-adjoin set1 set2)) + +(define (set-intersection set1 set2) + (set-fold (lambda (v set) + (if (in-set? v set1) + set1 + (set-disjoin v set1))) + set1 set2)) + +(define (set-difference set1 set2) + (set-fold set-disjoin set1 set2)) + +;; (define (set-xor set1 set2)) + + |