diff options
author | Hugo Hörnquist <hugo@lysator.liu.se> | 2022-06-28 16:53:27 +0200 |
---|---|---|
committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2022-07-07 21:19:15 +0200 |
commit | ac94e4ad80e1d77329f164457e9a16b0d826bd13 (patch) | |
tree | bc1c3838315528f3dfce5577dd7011e1f94d26af /module | |
parent | Add tree->list, -map, and -fold. (diff) | |
download | calp-tree.tar.gz calp-tree.tar.xz |
Add set on top of tree-table.tree
Diffstat (limited to 'module')
-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)) + + |