Add slset-delete and slset-contains?

Not strictly needed, but could be helpful and completes the
operations.  Also, if we ever reimplement it using some other
strategy, this might be more useful.

2 files changed, 35 insertions, 2 deletions

diff --git a/slsets.scm b/slsets.scm
index 8f5469c..9b93676 100644
--- a/slsets.scm
+++ b/slsets.scm
@@ -9,11 +9,12 @@
 (declare (disable-interrupts))
 
 (module slsets
-    (slset<= slset= slset-adjoin ;; TODO: slset-delete and slset-contains?
+    (slset<= slset= slset-adjoin
      slset-difference slset-intersection
      slset-difference+intersection
      slset-union slset-xor
-     slset-deduplicate)
+     slset-deduplicate
+     slset-delete slset-contains?)
 
 (import scheme (chicken base) (chicken plist))
 
@@ -159,4 +160,15 @@
                   (else (mark! x marking)
                         (lp (cdr lst) (cons x res)))))))))
 
+;; These are not really necessary - one can use memq and srfi-1's delete.
+;; But they're supplied so we have the full gamut of set operations.
+;; Also, deletion is a bit more ergonomic as it accepts multiple arguments.
+(define (slset-contains? slset el)
+  (and (memq el slset) #t))
+
+(define (slset-delete slset . els)
+  (with-marked-list els
+                    (lambda (m)
+                      (filter (lambda (x) (not (marked? x m))) slset))))
+
 )
diff --git a/tests/run.scm b/tests/run.scm
index e2bf76b..4d15ea7 100644
--- a/tests/run.scm
+++ b/tests/run.scm
@@ -56,6 +56,27 @@
     (test-group "all symbols used here still clean"
       (test-assert (clean? '(a b c d e i o u x)))))
 
+  (test-group "slset-delete"
+    (test-group "some examples"
+      (test '(a c d a c e)
+            (slset-delete '(a b c d a c e) 'b))
+      (test '(b c d c)
+            (slset-delete '(a b c d a c e) 'a 'e 'i))
+      (test '(b c d c e)
+            (slset-delete '(a b c d a c e) 'a 'a 'a))
+      (test '(a b c d a c e)
+            (slset-delete '(a b c d a c e) 'i)))
+    (test-group "all symbols used here still clean"
+      (test-assert (clean? '(a b c d e i)))))
+
+  (test-group "slset-contains?"
+    (test-group "some examples"
+      (test #t (slset-contains? '(a b c d a c e) 'a))
+      (test #t (slset-contains? '(a b c d a c e) 'a))
+      (test #f (slset-contains? '(a b c d a c e) 'i)))
+    (test-group "all symbols used here still clean"
+      (test-assert (clean? '(a b c d e i)))))
+
   (test-group "slset-union"
     (test-group "examples from srfi-1 document"
       (test '(u o i a b c d e) (slset-union '(a b c d e) '(a e i o u)))