Initial implementation of slsets egg

This implements sets of symbols *as lists*, like in the srfi-1 lset
operations.  It maintains the benefit of using lists for everything,
but not having to pay the quadratic performance penalty that srfi-1
entails.  We achieve this by using plist operations to "mark" items
so we have to visit the list "set" only a fixed number of times.

1 files changed, 100 insertions, 0 deletions

diff --git a/tests/run.scm b/tests/run.scm
new file mode 100644
index 0000000..06f4f2c
--- /dev/null
+++ b/tests/run.scm
@@ -0,0 +1,100 @@
+;; (load "../slsets.scm")
+(import slsets test)
+
+(test-group "slsets"
+  (test-group "slset<="
+    (test-group "examples from srfi-1 document"
+      (test-assert (slset<= '(a) '(a b a) '(a b c c)))
+      (test-assert "trivial case no args" (slset<=))
+      (test-assert "trivial case one arg" (slset<= '(a))))
+    (test-group "negatives"
+      (test-assert (not (slset<= '(a b a) '(a b c c) '(a))))
+      (test-assert (not (slset<= '(a b) '(a c))))))
+
+  (test-group "slset="
+    (test-group "examples from srfi-1 document"
+      (test-assert (slset= '(b e a) '(a e b) '(e e b a)))
+      (test-assert "trivial case no args" (slset=))
+      (test-assert "trivial case one arg" (slset= '(a))))
+    (test-group "negatives"
+      (test-assert (not (slset= '(b e a) '(a e b x) '(e e b a))))
+      (test-assert (not (slset= '(b e a x) '(a e b) '(e e b a))))
+      (test-assert (not (slset= '(b e a) '(a e b) '(e e b a x))))))
+
+  (test-group "slset-adjoin"
+    (test-group "example from srfi-1 document"
+      (test '(u o i a b c d c e)
+            (slset-adjoin '(a b c d c e) 'a 'e 'i 'o 'u)))
+    ;; Spec says it should, so check it
+    (test-group "result shares a common tail with the list argument"
+      (let* ((lst '(a b c d c e))
+             (result (slset-adjoin lst 'a 'x 'e 'b)))
+        (test-assert (eq? lst (cdr result))))))
+
+  (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)))
+      (test "Repeated elements in LIST1 are preserved"
+            '(x a a c)
+            (slset-union '(a a c) '(x a x)))
+      (test "trivial case no args"
+            '()
+            (slset-union))
+      (test "trivial case one arg"
+            '(a b c)
+            (slset-union '(a b c)))))
+
+  (test-group "slset-xor"
+    (test-group "examples from srfi-1 document"
+      ;;(test '(d c b i o u) (slset-xor '(a b c d e) '(a e i o u)))
+      ;; NOTE: The above has a peculiar ordering, but there's nothing
+      ;; in the spec guaranteeing it should be like that.  We return this:
+      (test '(b c d i o u) (slset-xor '(a b c d e) '(a e i o u)))
+      (test "trivial case no args"
+            '() (slset-xor))
+      (test "trivial case one arg"
+            '(a b c d e) (slset-xor '(a b c d e))))
+    (test-group "extra examples"
+      (test "for multiple lists, returns elements that appear in an odd number of lists"
+            '(c d i u e x) (slset-xor '(a b c d e) '(a e i o u) '(b o e) '(x)))
+      (test "duplicates in lists are preserved"
+            '(b b c d d i o u o) (slset-xor '(a b b c d e d) '(a e i o u o)))))
+
+  (test-group "slset-difference"
+    (test-group "examples from srfi-1 document"
+      (test '(b c d) (slset-difference '(a b c d e) '(a e i o u)))
+      (test "trivial case"
+            '(a b c) (slset-difference '(a b c))))
+    (test-group "more examples"
+      (test "duplicates in first list are preserved"
+            '(b b c d)
+            (slset-difference '(a b b c x x d x i e) '(a e i o u) '() '(x x y z z)))
+      (test "empty list returns same list"
+            '(a b b c d e)
+            (slset-difference '(a b b c d e) '()))
+      (test "empty list is empty"
+            '()
+            (slset-difference '() '(a b b c d e)))
+      (test "empty list is still empty after other args"
+            '()
+            (slset-difference '() '(a b) '(c d e) '()))))
+
+  (test-group "slset-intersection"
+    (test-group "examples from srfi-1 document"
+      (test '(a e) (slset-intersection '(a b c d e) '(a e i o u)))
+      (test "repeated elements in LIST1 are preserved"
+            '(a x a) (slset-intersection '(a x y a) '(x a x z)))
+      (test "trivial case"
+            '(a b c) (slset-intersection '(a b c))))
+    (test-group "more examples"
+      (test "multiple lists"
+            '(a a) (slset-intersection '(a x b y b a) '(x a x z) '(a b)))))
+
+  (test-group "slset-deduplicate (as per srfi-1's delete-duplicates)"
+    (test-group "example from srfi-1 document"
+      (test '(a b c z)
+            (slset-deduplicate '(a b a c a b c z))))
+    (test-group "more examples"
+      (test '() (slset-deduplicate '())))))
+
+(test-exit)