From ac94e4ad80e1d77329f164457e9a16b0d826bd13 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Tue, 28 Jun 2022 16:53:27 +0200 Subject: Add set on top of tree-table. --- module/hnh/util/set.scm | 46 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 46 insertions(+) create mode 100644 module/hnh/util/set.scm 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)) + + -- cgit v1.2.3