start testing SRFI 113 tests

9 files changed, 1072 insertions, 554 deletions

diff --git a/.gitignore b/.gitignore
index 0880f22..0ca72a6 100644
--- a/.gitignore
+++ b/.gitignore
@@ -4,3 +4,4 @@
 *.so
 *.link
 *.o
+*.types
diff --git a/mcgoron/weight-balanced-trees/internal.scm b/mcgoron/weight-balanced-trees/internal.scm
index 35a25bb..73bc00c 100644
--- a/mcgoron/weight-balanced-trees/internal.scm
+++ b/mcgoron/weight-balanced-trees/internal.scm
@@ -12,6 +12,7 @@
  | See the License for the specific language governing permissions and
  | limitations under the License.
  |#
+
 ;;; ;;;;;;;;;;;;;;;;;;;
 ;;; Definition of nodes and functions to calculate values for nodes.
 ;;; ;;;;;;;;;;;;;;;;;;;
@@ -61,6 +62,8 @@
 (define (wb-tree-node data left right)
   ;; Construct a node with `data`, `left`, and `right`, with the correct
   ;; weight.
+  (when (eof-object? data)
+    (error "eof object cannot be added to set" data))
   (%wb-tree-node data (calculate-weight left right) left right))
 
 (: balanced-as-child? (fixnum fixnum --> boolean))
@@ -363,7 +366,7 @@
 ;;; Single value operations
 ;;; ;;;;;;;;;;;;;;;;;;;;
 
-(: update (* node-type * (-> *) (-> node-type) -> node-type))
+(: update (* node-type * (* -> *) (-> node-type) -> node-type))
 (define (update cmp set to-search on-found on-not-found)
   (let update ((set set))
     (if (null? set)
diff --git a/mcgoron/weight-balanced-trees/internal.sld b/mcgoron/weight-balanced-trees/internal.sld
index 5d99d0c..f9bf4ac 100644
--- a/mcgoron/weight-balanced-trees/internal.sld
+++ b/mcgoron/weight-balanced-trees/internal.sld
@@ -28,6 +28,7 @@
                 ((the type expression) expression))))))
   (export wb-tree-node? non-null-wb-tree-node?
           wb-tree-node
+          with-node
           get-data get-left get-right get-size
           balanced?
           in-order-vector->node
diff --git a/mcgoron/weight-balanced-trees/srfi/113/sets.scm b/mcgoron/weight-balanced-trees/srfi/113/sets.scm
new file mode 100644
index 0000000..d9552db
--- /dev/null
+++ b/mcgoron/weight-balanced-trees/srfi/113/sets.scm
@@ -0,0 +1,371 @@
+#| Copyright 2024 Peter McGoron
+ |
+ | Licensed under the Apache License, Version 2.0 (the "License");
+ | you may not use this file except in compliance with the License.
+ | You may obtain a copy of the License at
+ |
+ |     http://www.apache.org/licenses/LICENSE-2.0
+ |
+ | Unless required by applicable law or agreed to in writing, software
+ | distributed under the License is distributed on an "AS IS" BASIS,
+ | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ | See the License for the specific language governing permissions and
+ | limitations under the License.
+ |#
+
+(define-record-type <set>
+  (raw-set comparator node)
+  set?
+  (comparator set-element-comparator)
+  (node get-node))
+
+(define (check-compatible! set1 set2)
+  (when (not (compatible-sets? set1 set2))
+    (error "sets have different comparators" set1 set2)))
+
+;;; ;;;;;;;;;;;;;;;;
+;;; Constructors
+;;; ;;;;;;;;;;;;;;;;
+
+(define (set-unfold comparator stop? mapper successor seed)
+  (let loop ((set '())
+             (seed seed))
+    (if (stop? seed)
+        (raw-set comparator set)
+        (let ((new-value (mapper seed)))
+          (loop (insert comparator set new-value)
+                (successor seed))))))
+
+(define (set comparator . elements)
+  (list->set comparator elements))
+
+;;; ;;;;;;;;;;;;;;;;;
+;;; Predicates (besides set?)
+;;; ;;;;;;;;;;;;;;;;;
+
+(define (set-contains? set element)
+  (let ((found? #t))
+    (search (set-element-comparator set)
+            (get-node set)
+            (lambda () (set! found? #f)))
+    found?))
+
+(define (set-empty? set)
+  (null? (get-node set)))
+
+(define (set-disjoint? set1 set2)
+  (set-empty? (set-intersection set1 set2)))
+
+;;; ;;;;;;;;;;;;;;;;;;;
+;;; Accessors
+;;; ;;;;;;;;;;;;;;;;;;;
+
+(define (set-member set element default)
+  (search (set-element-comparator set)
+          (get-node set)
+          element
+          (lambda () default)))
+
+;;; ;;;;;;;;;;;;;;;;;;;
+;;; Updaters
+;;; ;;;;;;;;;;;;;;;;;;;
+
+(define (set-adjoin set . elements)
+  (set-adjoin-all set elements))
+(define set-adjoin! set-adjoin)
+
+(define (set-replace set . elements)
+  (set-replace-all elements))
+(define set-replace! set-replace)
+
+(define (set-delete-all set elements)
+  (let ((cmp (set-element-comparator set)))
+    (fold (cut delete cmp <> <>) set elements)))
+(define set-delete-all! set-delete-all)
+
+(define (set-delete set . elements)
+  (set-delete-all set elements))
+(define set-delete! set-delete)
+
+(define (set-search! set element failure success)
+  ;; The SRFI mandates that `failure` and `success` are tail-called.
+  (define (%insert obj)
+    (values (set-adjoin set element) obj))
+  (define (%ignore obj)
+    (values set obj))
+  (define (%remove obj)
+    (values (set-remove set element) obj))
+  (define (%update new-element obj)
+    (values (set-replace (set-remove set element) new-element)
+            obj))
+  (let ((value (set-member set element (eof-object))))
+    (if (eof-object? value)
+        (failure %insert %ignore)
+        (success value %update %remove))))
+
+(define (set-size set) (get-size (get-node set)))
+
+;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; The whole set
+;;; 
+;;; Although these functions use generators, they cannot use the
+;;; generator SRFIs, because they might include the false value.
+;;; (this is an example of `false` acting like a null value, except
+;;; in the case of generators, there is no clever getting around it
+;;; like `assoc` or `member`).
+;;; 
+;;; Performance note: generators mutate values and hence might not work
+;;; well with write-barrier based systems like Chicken.
+;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define (set-find predicate? set failure)
+  (let ((gen (set->generator set)))
+    (let loop ((value (gen)))
+      (cond
+        ((eof-object? value) (failure))
+        ((predicate? value) value)
+        (else (loop (gen)))))))
+
+(define (set-count predicate set)
+  (define (count node)
+    (if (null? node)
+        0
+        (+ (if (predicate (get-data node)) 1 0)
+           (count (get-left node))
+           (count (get-right node)))))
+  (count (get-node set)))
+
+(define (set-any? predicate set)
+  (let ((gen (set->generator set)))
+    (let loop ((value (gen)))
+      (cond
+        ((eof-object? value) #f)
+        ((predicate value) #t)
+        (else (loop (gen)))))))
+
+(define (set-every? predicate set)
+  (let ((gen (set->generator set)))
+    (let loop ((value (gen)))
+      (cond
+        ((eof-object? value) #t)
+        ((predicate value) (loop (gen)))
+        (else #f)))))
+
+;;; ;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Mapping and folding
+;;; ;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define (set-map comparator proc old-set)
+  (let ((gen (set->generator old-set)))
+    (let set-map ((new-node '())
+                  (value (gen)))
+      (if (eof-object? value)
+          (raw-set comparator new-node)
+          (set-map (insert comparator new-node (proc value))
+                   (gen))))))
+
+(define (set-for-each proc set)
+  (let loop ((node (get-node set)))
+    (when (not (null? node))
+      (proc (get-data node))
+      (loop (get-left node))
+      (loop (get-right node)))))
+
+(define (set-fold proc nil set)
+  (define (node-fold nil node)
+    (if (null? node)
+        nil
+        (with-node (node data ("<" left) (">" right))
+          (let ((nil (proc data nil)))
+            (node-fold (node-fold nil left) right)))))
+  (node-fold nil (get-node set)))
+
+(define (set-filter predicate? set)
+  (define (loop node)
+    (if (null? node)
+        '()
+        (with-node (node data ("<" left) (">" right))
+          (if (predicate? data)
+              (join data (loop left) (loop right))
+              (join2 (loop left) (loop right))))))
+  (raw-set (set-element-comparator set)
+           (loop (get-node set))))
+(define set-filter! set-filter)
+
+(define (set-remove predicate? set)
+  (set-filter (lambda (x)
+                (not (predicate? x)))
+              set))
+(define set-remove! set-remove)
+
+(define (set-partition predicate? set)
+  (define (loop node)
+    (if (null? node)
+        (values '() '())
+        (with-node (node data ("<" left) (">" right))
+          (let-values (((yes-left no-left)
+                        (loop left))
+                       ((yes-right no-right)
+                        (loop right)))
+            (if (predicate? data)
+                (values (join data yes-left yes-right)
+                        (join2 no-left no-right))
+                (values (join2 yes-left yes-right)
+                        (join data no-left no-right)))))))
+  (let-values (((yes no) (loop (get-node set)))
+               ((cmp) (set-element-comparator set)))
+    (values (raw-set cmp yes)
+            (raw-set cmp no))))
+
+(define set-partition! set-partition)
+
+;;; ;;;;;;;;;;;;;;;;;;;;;;
+;;; Copying and conversion
+;;; ;;;;;;;;;;;;;;;;;;;;;;
+
+(define (set-copy set)
+  ;; NOTE: This function is useless for this implementation because nodes
+  ;; can never be modified.
+  set
+  #;(define (node-copy node)
+      (if (null? node)
+          '()
+          (with-node (node data ("<" left) (">" right))
+            (wb-tree-node data (node-copy left) (node-copy right)))))
+  #;(raw-set (get-element-comparator set) (node-copy node)))
+
+(define (list->set comparator lst)
+  (set-unfold comparator null? car cdr lst))
+
+(define (set->list set)
+  (generator->list (set->generator set)))
+
+(define (list->set! set elements)
+  (set-union set (list->set (set-element-comparator set) elements)))
+
+;;; ;;;;;;;;;;;;;;;;;;;
+;;; Subsets
+;;; ;;;;;;;;;;;;;;;;;;;
+
+(define (apply-nary-predicate binary)
+  (lambda (first . rest)
+    (let ((cmp (set-element-comparator first)))
+      (let loop ((arg1 first)
+                 (arg-rest rest))
+        (if (null? arg-rest)
+            #t
+            (let ((arg2 (car arg-rest)))
+              (check-compatible! arg1 arg2)
+              (if (binary cmp arg1 arg2)
+                  (loop arg2 (cdr arg-rest))
+                  #f)))))))
+(define set=?
+  (apply-nary-predicate
+   (lambda (cmp set1 set2)
+     (and (= (set-size set1) (set-size set2))
+          (let ((gen1 (set->in-order-generator set1))
+                (gen2 (set->in-order-generator set2)))
+            (let loop ((value1 (gen1))
+                       (value2 (gen2)))
+              (cond
+                ((and (eof-object? value1) (eof-object? value2)) #t)
+                ((=? cmp value1 value2) (loop (gen1) (gen2)))
+                (else #f))))))))
+
+(define set<=?
+  (apply-nary-predicate
+   (lambda (cmp set1 set2)
+     (and (<= (set-size set1) (set-size set2))
+          (set-every? (cut set-contains? set2 <>) set1)))))
+
+(define set<?
+  (apply-nary-predicate
+   (lambda (cmp set1 set2)
+     (and (< (set-size set1) (set-size set2))
+          (set-every? (cut set-contains? set2 <>) set1)))))
+
+(define set>?
+  (apply-nary-predicate
+   (lambda (cmp set1 set2)
+     (and (> (set-size set1) (set-size set2))
+          (set-every? (cut set-contains? set1 <>) set2)))))
+
+(define set>=?
+  (apply-nary-predicate
+   (lambda (cmp set1 set2)
+     (and (>= (set-size set1) (set-size set2))
+          (set-every? (cut set-contains? set1 <>) set2)))))
+
+;;; ;;;;;;;;;;;;;;;;
+;;; Set theory operations
+;;; ;;;;;;;;;;;;;;;;
+
+(define (apply-nary-procedure binary)
+  (lambda (first . rest)
+    (let ((cmp (set-element-comparator first)))
+      (let loop ((arg1 first)
+                 (arg-rest rest))
+        (if (null? arg-rest)
+            arg1
+            (begin
+              (check-compatible! arg1 (car arg-rest))
+              (loop (binary cmp arg1 (car arg-rest)) (cdr arg-rest))))))))
+
+(define set-union (apply-nary-procedure union))
+(define set-union! set-union)
+
+(define set-intersection (apply-nary-procedure intersection))
+(define set-intersection! set-intersection)
+
+(define set-difference (apply-nary-procedure difference))
+(define set-difference! set-difference)
+
+(define set-xor (apply-nary-procedure xor))
+(define set-xor! set-xor)
+
+;;; ;;;;;;;;;;;;
+;;; exported extensions
+;;; ;;;;;;;;;;;;
+
+(define (set-adjoin-all set elements)
+  (let ((cmp (set-element-comparator set)))
+    (fold (lambda (new set)
+            (update cmp
+                    set
+                    new
+                    (lambda (old) old)
+                    (lambda ()
+                      (wb-tree-node new '() '()))))
+          (get-node set)
+          elements)))
+
+(define (set-replace-all set elements)
+  (let ((cmp (set-element-comparator set)))
+    (fold (lambda (new set)
+            (update cmp
+                    set
+                    new
+                    (lambda (old) new)
+                    (lambda ()
+                      (wb-tree-node new '() '()))))
+          (get-node set)
+          elements)))
+
+(define (generator->set comparator gen)
+  (raw-set comparator (generator->node comparator gen)))
+
+(define (set->generator set)
+  (node->generator (get-node set)))
+
+(define (set->in-order-generator set)
+  (node->in-order-generator (get-node set)))
+
+(define (set->reverse-order-generator set)
+  (node->reverse-order-generator (get-node set)))
+
+(define compatible-sets?
+  (apply-nary-predicate
+   (lambda (cmp s1 s2)
+     (and (eq? cmp (set-element-comparator s1))
+          (eq? cmp (set-element-comparator s2))))))
+
diff --git a/mcgoron/weight-balanced-trees/srfi/113/sets.sld b/mcgoron/weight-balanced-trees/srfi/113/sets.sld
new file mode 100644
index 0000000..ccc578d
--- /dev/null
+++ b/mcgoron/weight-balanced-trees/srfi/113/sets.sld
@@ -0,0 +1,35 @@
+#| Copyright 2024 Peter McGoron
+ |
+ | Licensed under the Apache License, Version 2.0 (the "License");
+ | you may not use this file except in compliance with the License.
+ | You may obtain a copy of the License at
+ |
+ |     http://www.apache.org/licenses/LICENSE-2.0
+ |
+ | Unless required by applicable law or agreed to in writing, software
+ | distributed under the License is distributed on an "AS IS" BASIS,
+ | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ | See the License for the specific language governing permissions and
+ | limitations under the License.
+ |#
+
+(define-library (mcgoron weight-balanced-trees srfi 113 sets)
+  (import (scheme base)
+          (scheme case-lambda)
+          (mcgoron weight-balanced-trees internal)
+          (srfi 1) (srfi 26) (srfi 128) (srfi 158))
+  (export set set-unfold
+          set? set-contains? set-empty? set-disjoint?
+          set-member set-element-comparator
+          set-adjoin set-adjoin! set-replace set-replace!
+          set-delete set-delete! set-delete-all set-delete-all! set-search!
+          set-size set-find set-count set-any? set-every?
+          set-map set-for-each set-fold set-filter set-filter! set-remove set-remove! set-partition set-partition!
+          set-copy set->list list->set list->set!
+          set=? set<? set>? set<=? set>=?
+          set-union set-intersection set-difference set-xor
+          set-union! set-intersection! set-difference! set-xor!
+          ;;  Extra procedures
+          compatible-sets? generator->set set->generator)
+  (include "sets.scm"))
+
diff --git a/tests/internal.scm b/tests/internal.scm
new file mode 100644
index 0000000..fc61f6e
--- /dev/null
+++ b/tests/internal.scm
@@ -0,0 +1,552 @@
+#| Copyright 2024 Peter McGoron
+ |
+ | Licensed under the Apache License, Version 2.0 (the "License");
+ | you may not use this file except in compliance with the License.
+ | You may obtain a copy of the License at
+ |
+ |     http://www.apache.org/licenses/LICENSE-2.0
+ |
+ | Unless required by applicable law or agreed to in writing, software
+ | distributed under the License is distributed on an "AS IS" BASIS,
+ | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ | See the License for the specific language governing permissions and
+ | limitations under the License.
+ |----------------------------------------------
+ | This test suite would be better if property tests (and by association
+ | generators) could take multiple values. As it stands now property
+ | test generators cannot be correlated without doing a hack like returning
+ | a vector (which the current implementation does).
+ |#
+
+;;; ;;;;;;;;;;;;;;;;
+;;; Parameters
+
+(define verbose (make-parameter #f))
+(define max-vector-length (make-parameter 100))
+
+;;; ;;;;;;;;;;;;;;;;;;;
+;;; Random in-order vector generator
+;;; ;;;;;;;;;;;;;;;;;;;
+
+(define (vector->node-generator)
+  (gmap in-order-vector->node (in-order-vector-generator
+                               (max-vector-length))))
+
+(define number-comparator
+  (make-comparator
+   number?
+   =
+   <
+   (lambda (x) x)))
+
+;;; ;;;;;;;;;;;;;;;;;;;;;;
+;;; Test node creation
+;;; ;;;;;;;;;;;;;;;;;;;;;;
+
+(test-group "in-order-vector->node and node->in-order-list round-trip"
+  (define (vector->node->list? vec)
+    (let* ((node (in-order-vector->node vec))
+           (lst (node->in-order-list node)))
+      (when (verbose)
+        (dynamic-property-set! 'vec vec)
+        (dynamic-property-set! 'lst lst))
+      (equal? (vector->list vec) lst)))
+  (test-property vector->node->list?
+                 (list (in-order-vector-generator (max-vector-length)))))
+
+(test-group "in-order-vector->node is balanced?"
+  (test-assert (balanced? '()))
+  (test-property balanced? (list (vector->node-generator))))
+
+;;; ;;;;;;;;;
+;;; Make a "split" vector. A "split" vector is two sorted vectors and a 
+;;; number, where for all indicies i
+;;; 
+;;;      v1[i] < number
+;;;      number < v2[i]
+;;;   
+;;; ;;;;;;;;;
+
+(define (split-in-order-vector vec)
+  ;; Take an in order vector and split it into two in-order vectors and
+  ;; an element in between those two vectors.
+  (let* ((len (vector-length vec))
+         (pivot ((make-random-integer-generator 0 len))))
+    (vector (vector-copy-exclusive vec 0 pivot)
+            (vector-ref vec pivot)
+            (vector-copy-exclusive vec (+ pivot 1) len))))
+
+(define (split-vector-generator)
+  (chain (in-order-vector-generator (max-vector-length))
+         (gmap split-in-order-vector _)))
+
+(define (call/split-vecs procedure)
+  (lambda (vec)
+    (let ((left (vector-ref vec 0))
+          (middle (vector-ref vec 1))
+          (right (vector-ref vec 2)))
+      (procedure left middle right))))
+
+(define (join-vectors left middle right)
+  (join middle (in-order-vector->node left) (in-order-vector->node right)))
+
+;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; join
+;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define join-preserves-order-of
+  (call/split-vecs
+   (lambda (left middle right)
+     ;; Test if joining two in-order vectors with a node in between will
+     ;; preserve order in the tree.
+     ;; Log the left, middle, and right vectors.
+     (when (verbose)
+       (dynamic-property-set! 'right right)
+       (dynamic-property-set! 'middle middle)
+       (dynamic-property-set! 'left left))
+     (let ((ret (node->in-order-list
+                 (join-vectors left middle right)))
+           (orig (append (vector->list left)
+                         (list middle)
+                         (vector->list right))))
+       (when (verbose)
+         (dynamic-property-set! 'ret ret))
+       (equal? ret orig)))))
+
+(test-group "join of in-order vectors preserves order"
+  (parameterize ((verbose #f))
+    (test-property join-preserves-order-of
+                   (list (split-vector-generator)))))
+
+(test-group "join of in-order vectors is balanced"
+  (define (joined-vector-generator)
+    (gmap (call/split-vecs join-vectors)
+          (split-vector-generator)))
+  (test-property balanced? (list (joined-vector-generator))))
+
+;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; join2
+;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define join2-preserves-order-of
+  (call/split-vecs
+   (lambda (left _ right)
+     (let ((ret (node->in-order-list
+                 (join2 (in-order-vector->node left)
+                        (in-order-vector->node right))))
+           (orig (append (vector->list left)
+                         (vector->list right))))
+       (equal? ret orig)))))
+
+(test-group "join2 of in-order vectors preserves order"
+  (test-property join2-preserves-order-of
+                 (list (split-vector-generator))))
+
+(test-group "join2 of in-order vectors is balanced"
+  (define (join2-split-vector-generator)
+    (define (join2-of-split vec)
+      (join2 (in-order-vector->node (vector-ref vec 0))
+             (in-order-vector->node (vector-ref vec 2))))
+    (gmap join2-of-split (split-vector-generator)))
+  (test-property balanced?
+                 (list (join2-split-vector-generator))))
+
+;;; ;;;;;;
+;;; search
+;;; ;;;;;;
+
+(define (call/inserted procedure)
+  (call/split-vecs
+   (lambda (left middle right)
+     (let ((node (join-vectors left middle right)))
+       (procedure left middle right node)))))
+
+(define (call-w/o-inserted procedure)
+  (call/split-vecs
+   (lambda (left middle right)
+     (let ((node (join2 (in-order-vector->node left)
+                        (in-order-vector->node right))))
+       (procedure left middle right node)))))
+
+(test-group "search with inserted node"
+  (define search-finds
+    (call/inserted
+     (lambda (left middle right node)
+       (when (verbose)
+         (dynamic-property-set! 'expected middle)
+         (dynamic-property-set! 'right right)
+         (dynamic-property-set! 'left left)
+         (dynamic-property-set! 'node (node->in-order-list node)))
+       (search number-comparator middle node))))
+  (parameterize ((verbose #f))
+    (test-property search-finds (list (split-vector-generator)))))
+
+(test-group "search without inserted node"
+  (define search-does-not-find
+    (call-w/o-inserted
+     (lambda (left middle right node)
+       (not (search number-comparator middle node)))))
+  (test-property search-does-not-find (list (split-vector-generator))))
+
+;;; ;;;;;;;;;;;;;;;;;;;;;;;;
+;;; split
+;;; ;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define (call/split wrapper procedure)
+  (wrapper
+   (lambda (left middle right node)
+     (call-with-values (lambda ()
+                         (split number-comparator node middle
+                                (lambda () #f)))
+       procedure))))
+
+(test-group "split finds"
+  (define split-finds
+    (call/split
+     call/inserted
+     (lambda (new-left found? new-right)
+       found?)))
+  (test-property split-finds (list (split-vector-generator))))
+
+(test-group "left tree from split with found element is balanced"
+  (define split-left-balanced
+    (call/split
+     call/inserted
+     (lambda (new-found found? new-right)
+       (balanced? new-found))))
+  (test-property split-left-balanced (list (split-vector-generator))))
+
+(test-group "right tree from split with found element is balanced"
+  (define split-right-balanced
+    (call/split
+     call/inserted
+     (lambda (new-found found? new-right)
+       (balanced? new-right))))
+  (test-property split-right-balanced (list (split-vector-generator))))
+
+(test-group "split should not find element not in left or right"
+  (define split-does-not-find
+    (call/split
+     call-w/o-inserted
+     (lambda (new-left found? new-right)
+       (not found?))))
+  (test-property split-does-not-find (list (split-vector-generator))))
+
+(test-group "left tree from split without found element is balanced"
+  (define split-left-balanced-w/o-inserted
+    (call/split
+     call-w/o-inserted
+     (lambda (new-left found? new-right)
+       (balanced? new-left))))
+  (test-property split-left-balanced-w/o-inserted (list (split-vector-generator))))
+
+(test-group "right tree from split without found element is balanced"
+  (define split-right-balanced-w/o-inserted
+    (call/split
+     call-w/o-inserted
+     (lambda (new-left found? new-right)
+       (balanced? new-right))))
+  (test-property split-right-balanced-w/o-inserted (list (split-vector-generator))))
+
+;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Union
+;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(test-group "union is balanced"
+  (define (union-balanced node1 node2)
+    (balanced? (union number-comparator node1 node2)))
+  (test-property union-balanced
+                 (list (vector->node-generator)
+                       (vector->node-generator))))
+
+(define (union-subset-of-lset node1 node2)
+    (let ((node (union number-comparator node1 node2))
+          (union (lset-union =
+                             (node->in-order-list node1)
+                             (node->in-order-list node2))))
+      (if (verbose)
+          (dynamic-property-set! 'union
+                                 (node->in-order-list node)))
+      (every (cut search number-comparator <> node) union)))
+
+(test-group "union subset of lset"
+  (parameterize ((verbose #t))
+    (test-property union-subset-of-lset
+                   (list (vector->node-generator)
+                         (vector->node-generator)))))
+
+(test-group "union subset of lset, right null"
+  (test-property union-subset-of-lset
+                 (list (vector->node-generator)
+                       (circular-generator '()))))
+
+(test-group "union subset of lset, left null"
+  (test-property union-subset-of-lset
+                 (list (circular-generator '())
+                       (vector->node-generator))))
+
+(define (lset-subset-of-union node1 node2)
+  (let ((node (union number-comparator node1 node2))
+        (union (lset-union =
+                           (node->in-order-list node1)
+                           (node->in-order-list node2))))
+    (node-every (cut memq <> union) node)))
+
+(test-group "lset subset of union"
+  (test-property lset-subset-of-union
+                 (list (vector->node-generator)
+                       (vector->node-generator))))
+
+(test-group "lset subset of union, right null"
+  (test-property lset-subset-of-union
+                 (list (vector->node-generator)
+                       (circular-generator '()))))
+
+(test-group "lset subset of union, left null"
+  (test-property lset-subset-of-union
+                 (list (circular-generator '())
+                       (vector->node-generator))))
+
+;;; ;;;;;;;;;;;;;;;;;;;;
+;;; Intersection
+;;; ;;;;;;;;;;;;;;;;;;;;
+
+(test-group "intersection balanced?"
+  (define (intersection-balanced? node1 node2)
+    (balanced? (intersection number-comparator node1 node2)))
+  (test-property intersection-balanced?
+                 (list (vector->node-generator)
+                       (vector->node-generator))))
+
+(test-group "intersection of itself"
+  (define (intersection-of-itself node1)
+    (let ((node (intersection number-comparator node1 node1))
+          (lst (node->in-order-list node1)))
+      (every (cut search number-comparator <> node) lst)))
+  (test-property intersection-of-itself
+                 (list (vector->node-generator))))
+
+(test-group "intersection of null, left"
+  (define (intersection-of-null-left node1)
+    (null? (intersection number-comparator node1 '())))
+  (test-property intersection-of-null-left
+                 (list (vector->node-generator))))
+
+(test-group "intersection of null, right"
+  (define (intersection-of-null-right node1)
+    (null? (intersection number-comparator '() node1)))
+  (test-property intersection-of-null-right 
+                 (list (vector->node-generator))))
+
+(test-group "intersection subset of lset"
+  (define (intersection-lset node1 node2)
+    (let ((node (intersection number-comparator node1 node2))
+          (intersection (lset-intersection =
+                                           (node->in-order-list node1)
+                                           (node->in-order-list node2))))
+      (every (cut search number-comparator <> node) intersection)))
+  (test-property intersection-lset
+                 (list (vector->node-generator)
+                       (vector->node-generator))))
+
+(test-group "lset subset of intersection"
+  (define (lset-subset-of-intersection node1 node2)
+    (let ((node (intersection number-comparator node1 node2))
+          (intersection (lset-intersection =
+                                           (node->in-order-list node1)
+                                           (node->in-order-list node2))))
+      (node-every (cut memv <> intersection) node)))
+  (test-property lset-subset-of-intersection
+                 (list (vector->node-generator)
+                       (vector->node-generator))))
+
+;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Difference
+;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(test-group "difference balanced?"
+  (define (difference-balanced? node1 node2)
+    (balanced? (difference number-comparator node1 node2)))
+  (test-property difference-balanced?
+                 (list (vector->node-generator)
+                       (vector->node-generator))))
+
+(test-group "difference subset of lset"
+  (define (difference-subset-of-lset node1 node2)
+    (let ((node (difference number-comparator node1 node2))
+          (intersection (lset-difference =
+                                         (node->in-order-list node1)
+                                         (node->in-order-list node2))))
+      (every (cut search number-comparator <> node) intersection)))
+  (test-property difference-subset-of-lset
+                 (list (vector->node-generator)
+                       (vector->node-generator))))
+
+(test-group "lset subset of difference"
+  (define (lset-subset-of-difference node1 node2)
+    (let ((node (difference number-comparator node1 node2))
+          (intersection (lset-difference =
+                                         (node->in-order-list node1)
+                                         (node->in-order-list node2))))
+      (node-every (cut memq <> intersection) node)))
+  (test-property lset-subset-of-difference
+                 (list (vector->node-generator)
+                       (vector->node-generator))))
+
+;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Update
+;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define %insert insert)
+(define (insert elem set)
+  (%insert number-comparator
+           set
+           elem))
+
+(test-group "update of unordered list is balanced"
+  (define (insert-unordered lst)
+    (let ((set (fold insert '() lst)))
+      (balanced? set)))
+  (test-property insert-unordered
+                 (list (list-generator-of
+                        (exact-integer-generator)))))
+
+(test-group "update of unordered list is subset of list"
+  (define (subset-of-list lst)
+    (let ((set (fold insert '() lst)))
+      (when (verbose)
+        (dynamic-property-set! 'lst lst)
+        (dynamic-property-set! 'set (node->in-order-list set)))
+      (every (cut search number-comparator <> set) lst)))
+  (parameterize ((verbose #f))
+    (test-property subset-of-list
+                   (list (list-generator-of
+                          (exact-integer-generator))))))
+
+(test-group "list is subset of update of unordered list"
+  (define (list-is-subset-of lst)
+    (let ((set (fold insert '() lst)))
+      (node-every (cut memq <> lst) set)))
+  (test-property list-is-subset-of
+                 (list (list-generator-of
+                        (exact-integer-generator)))))
+
+;;; ;;;;;;;;;;;;;;;;
+;;; Delete
+;;; ;;;;;;;;;;;;;;;;
+
+(define (call/difference procedure)
+  (lambda (lst1 lst2)
+    (let* ((set1 (fold insert '() lst1))
+           (set2 (fold insert '() lst2))
+           (diff (difference number-comparator set1 set2))
+           (deleted (fold (lambda (elem set)
+                            (when (verbose)
+                              (dynamic-property-set! 'elem elem)
+                              (dynamic-property-set! 'set set))
+                            (delete number-comparator set elem))
+                          set1
+                          lst2)))
+      (procedure lst1 lst2 diff deleted))))
+
+(test-group "delete of elements unordered list is balanced"
+  (define (delete-balanced? lst1 lst2)
+    (let* ((set (fold insert '() lst1))
+           (deleted (fold (lambda (elem set)
+                            (delete number-comparator set elem))
+                          set
+                          lst2)))
+      (balanced? deleted)))
+  (test-property delete-balanced?
+                 (list (list-generator-of (exact-integer-generator))
+                       (list-generator-of (exact-integer-generator)))))
+
+(test-group "delete of two sets is subset of difference"
+  (define (delete-and-difference lst1 lst2 diff deleted)
+    (node-every (cut search number-comparator <> diff) deleted))
+  (parameterize ((verbose #f))
+    (test-property (call/difference delete-and-difference)
+                   (list (list-generator-of (exact-integer-generator))
+                         (list-generator-of (exact-integer-generator))))))
+
+(test-group "difference is subset of delete of two sets"
+  (define (difference-and-delete lst1 lst2 diff deleted)
+    (node-every (cut search number-comparator <> deleted) diff))
+  (test-property (call/difference difference-and-delete)
+                 (list (list-generator-of (exact-integer-generator))
+                       (list-generator-of (exact-integer-generator)))))
+
+;;; ;;;;;;;;;;;;;;;;;;;;;;;
+;;; xor
+;;; ;;;;;;;;;;;;;;;;;;;;;;;
+
+(test-group "xor balanced?"
+  (define (xor-balanced? node1 node2)
+    (balanced? (xor number-comparator node1 node2)))
+  (test-property xor-balanced?
+                 (list (vector->node-generator) (vector->node-generator))))
+
+(test-group "lset subset of xor"
+  (define (lset-subset-of-xor lst1 lst2)
+    (let* ((node1 (fold insert '() lst1))
+           (node2 (fold insert '() lst2))
+           (set-xor (xor number-comparator node1 node2))
+           (list-xor (lset-xor = lst1 lst2)))
+      (every (cut search number-comparator <> set-xor) list-xor)))
+  (test-property lset-subset-of-xor
+                 (list (list-generator-of (exact-integer-generator))
+                       (list-generator-of (exact-integer-generator)))))
+
+(test-group "xor subset of lset"
+  (define (xor-subset-of-lset lst1 lst2)
+    (let* ((node1 (fold insert '() lst1))
+           (node2 (fold insert '() lst2))
+           (set-xor (xor number-comparator node1 node2))
+           (list-xor (lset-xor = lst1 lst2)))
+      (node-every (cut member <> list-xor) set-xor)))
+  (test-property xor-subset-of-lset
+                 (list (list-generator-of (exact-integer-generator))
+                       (list-generator-of (exact-integer-generator)))))
+
+;;; ;;;;;;;;;;
+;;; Generators
+;;; ;;;;;;;;;;
+
+(test-group "node->generator"
+  (define (node->generator-works lst)
+    (let* ((node (fold insert '() lst))
+           (result-lst
+            (generator->list (node->generator node))))
+      (lset= = lst result-lst)))
+  (test-property node->generator-works
+                 (list (list-generator-of (exact-integer-generator)))))
+
+(test-group "generator->node"
+  (define (generator->node-works lst)
+    (let* ((gen (list->generator lst))
+           (node (generator->node number-comparator gen)))
+      (and (node-every (cut member <> lst) node)
+           (every (cut search number-comparator <> node) lst))))
+  (test-property generator->node-works
+                 (list (list-generator-of (exact-integer-generator)))))
+
+(test-group "node->in-order-generator"
+  (define (node->in-order-generator-works lst)
+    (let* ((node (fold insert '() lst))
+           (result-lst (generator->list
+                        (node->in-order-generator node))))
+      (and (lset= = lst result-lst)
+           (list-sorted? < result-lst))))
+  (test-property node->in-order-generator-works
+                 (list (list-generator-of (exact-integer-generator)))))
+
+(test-group "node->reverse-order-generator"
+  (define (node->reverse-order-generator-works lst)
+    (let* ((node (fold insert '() lst))
+           (result-lst (generator->list
+                        (node->reverse-order-generator node))))
+      (and (lset= = lst result-lst)
+           (list-sorted? > result-lst))))
+  (test-property node->reverse-order-generator-works
+                 (list (list-generator-of (exact-integer-generator)))))
+
diff --git a/tests/run.scm b/tests/run.scm
index 6aabe8e..23114bd 100644
--- a/tests/run.scm
+++ b/tests/run.scm
@@ -11,567 +11,45 @@
  | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  | See the License for the specific language governing permissions and
  | limitations under the License.
- |----------------------------------------------
- | This test suite would be better if property tests (and by association
- | generators) could take multiple values. As it stands now property
- | test generators cannot be correlated without doing a hack like returning
- | a vector (which the current implementation does).
  |#
 
-(import r7rs)
+(import r7rs
+        (srfi 64) (mcgoron srfi 64))
 
 (load "random-number-vector.sld")
 (load "util.sld")
 
-(import (mcgoron weight-balanced-trees test util)
-        (mcgoron weight-balanced-trees test random-number-vector)
-        (prefix (only (mcgoron srfi 64) factory) mcgoron-test-)
-        (except (mcgoron srfi 64) factory)
-        (srfi 1) (srfi 26) (srfi 64) (srfi 128) (srfi 132) (srfi 133)
-        (srfi 158) (srfi 194) (srfi 197) (srfi 252)
-        (except (mcgoron weight-balanced-trees internal)
-                every)
-        (prefix (only (mcgoron weight-balanced-trees internal)
-                      every)
-                node-))
-
-;;; ;;;;;;;;;;;;;;;;
-;;; Parameters
-
-(define verbose (make-parameter #f))
-(define max-vector-length (make-parameter 100))
-
 ;;; ;;;;;;;;;;;;;;;;;;;;
 ;;; Setup my test runner
 ;;; ;;;;;;;;;;;;;;;;;;;;
 
-(test-runner-factory mcgoron-test-factory)
+(test-runner-factory factory)
 (test-runner-current (test-runner-create))
 (set-verbosity! '(fails))
 
-;;; ;;;;;;;;;;;;;;;;;;;
-;;; Random in-order vector generator
-;;; ;;;;;;;;;;;;;;;;;;;
-
-(define (vector->node-generator)
-  (gmap in-order-vector->node (in-order-vector-generator
-                               (max-vector-length))))
-
-(define number-comparator
-  (make-comparator
-   number?
-   =
-   <
-   (lambda (x) x)))
-
-;;; ;;;;;;;;;;;;;;;;;;;;;;
-;;; Test node creation
-;;; ;;;;;;;;;;;;;;;;;;;;;;
-
-(test-group "in-order-vector->node and node->in-order-list round-trip"
-  (define (vector->node->list? vec)
-    (let* ((node (in-order-vector->node vec))
-           (lst (node->in-order-list node)))
-      (when (verbose)
-        (dynamic-property-set! 'vec vec)
-        (dynamic-property-set! 'lst lst))
-      (equal? (vector->list vec) lst)))
-  (test-property vector->node->list?
-                 (list (in-order-vector-generator (max-vector-length)))))
-
-(test-group "in-order-vector->node is balanced?"
-  (test-assert (balanced? '()))
-  (test-property balanced? (list (vector->node-generator))))
-
-;;; ;;;;;;;;;
-;;; Make a "split" vector. A "split" vector is two sorted vectors and a 
-;;; number, where for all indicies i
-;;; 
-;;;      v1[i] < number
-;;;      number < v2[i]
-;;;   
-;;; ;;;;;;;;;
-
-(define (split-in-order-vector vec)
-  ;; Take an in order vector and split it into two in-order vectors and
-  ;; an element in between those two vectors.
-  (let* ((len (vector-length vec))
-         (pivot ((make-random-integer-generator 0 len))))
-    (vector (vector-copy-exclusive vec 0 pivot)
-            (vector-ref vec pivot)
-            (vector-copy-exclusive vec (+ pivot 1) len))))
-
-(define (split-vector-generator)
-  (chain (in-order-vector-generator (max-vector-length))
-         (gmap split-in-order-vector _)))
-
-(define (call/split-vecs procedure)
-  (lambda (vec)
-    (let ((left (vector-ref vec 0))
-          (middle (vector-ref vec 1))
-          (right (vector-ref vec 2)))
-      (procedure left middle right))))
-
-(define (join-vectors left middle right)
-  (join middle (in-order-vector->node left) (in-order-vector->node right)))
-
-;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; join
-;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define join-preserves-order-of
-  (call/split-vecs
-   (lambda (left middle right)
-     ;; Test if joining two in-order vectors with a node in between will
-     ;; preserve order in the tree.
-     ;; Log the left, middle, and right vectors.
-     (when (verbose)
-       (dynamic-property-set! 'right right)
-       (dynamic-property-set! 'middle middle)
-       (dynamic-property-set! 'left left))
-     (let ((ret (node->in-order-list
-                 (join-vectors left middle right)))
-           (orig (append (vector->list left)
-                         (list middle)
-                         (vector->list right))))
-       (when (verbose)
-         (dynamic-property-set! 'ret ret))
-       (equal? ret orig)))))
-
-(test-group "join of in-order vectors preserves order"
-  (parameterize ((verbose #f))
-    (test-property join-preserves-order-of
-                   (list (split-vector-generator)))))
-
-(test-group "join of in-order vectors is balanced"
-  (define (joined-vector-generator)
-    (gmap (call/split-vecs join-vectors)
-          (split-vector-generator)))
-  (test-property balanced? (list (joined-vector-generator))))
-
-;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; join2
-;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define join2-preserves-order-of
-  (call/split-vecs
-   (lambda (left _ right)
-     (let ((ret (node->in-order-list
-                 (join2 (in-order-vector->node left)
-                        (in-order-vector->node right))))
-           (orig (append (vector->list left)
-                         (vector->list right))))
-       (equal? ret orig)))))
-
-(test-group "join2 of in-order vectors preserves order"
-  (test-property join2-preserves-order-of
-                 (list (split-vector-generator))))
-
-(test-group "join2 of in-order vectors is balanced"
-  (define (join2-split-vector-generator)
-    (define (join2-of-split vec)
-      (join2 (in-order-vector->node (vector-ref vec 0))
-             (in-order-vector->node (vector-ref vec 2))))
-    (gmap join2-of-split (split-vector-generator)))
-  (test-property balanced?
-                 (list (join2-split-vector-generator))))
-
-;;; ;;;;;;
-;;; search
-;;; ;;;;;;
-
-(define (call/inserted procedure)
-  (call/split-vecs
-   (lambda (left middle right)
-     (let ((node (join-vectors left middle right)))
-       (procedure left middle right node)))))
-
-(define (call-w/o-inserted procedure)
-  (call/split-vecs
-   (lambda (left middle right)
-     (let ((node (join2 (in-order-vector->node left)
-                        (in-order-vector->node right))))
-       (procedure left middle right node)))))
-
-(test-group "search with inserted node"
-  (define search-finds
-    (call/inserted
-     (lambda (left middle right node)
-       (when (verbose)
-         (dynamic-property-set! 'expected middle)
-         (dynamic-property-set! 'right right)
-         (dynamic-property-set! 'left left)
-         (dynamic-property-set! 'node (node->in-order-list node)))
-       (search number-comparator middle node))))
-  (parameterize ((verbose #f))
-    (test-property search-finds (list (split-vector-generator)))))
-
-(test-group "search without inserted node"
-  (define search-does-not-find
-    (call-w/o-inserted
-     (lambda (left middle right node)
-       (not (search number-comparator middle node)))))
-  (test-property search-does-not-find (list (split-vector-generator))))
-
-;;; ;;;;;;;;;;;;;;;;;;;;;;;;
-;;; split
-;;; ;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (call/split wrapper procedure)
-  (wrapper
-   (lambda (left middle right node)
-     (call-with-values (lambda ()
-                         (split number-comparator node middle
-                                (lambda () #f)))
-       procedure))))
-
-(test-group "split finds"
-  (define split-finds
-    (call/split
-     call/inserted
-     (lambda (new-left found? new-right)
-       found?)))
-  (test-property split-finds (list (split-vector-generator))))
-
-(test-group "left tree from split with found element is balanced"
-  (define split-left-balanced
-    (call/split
-     call/inserted
-     (lambda (new-found found? new-right)
-       (balanced? new-found))))
-  (test-property split-left-balanced (list (split-vector-generator))))
-
-(test-group "right tree from split with found element is balanced"
-  (define split-right-balanced
-    (call/split
-     call/inserted
-     (lambda (new-found found? new-right)
-       (balanced? new-right))))
-  (test-property split-right-balanced (list (split-vector-generator))))
-
-(test-group "split should not find element not in left or right"
-  (define split-does-not-find
-    (call/split
-     call-w/o-inserted
-     (lambda (new-left found? new-right)
-       (not found?))))
-  (test-property split-does-not-find (list (split-vector-generator))))
-
-(test-group "left tree from split without found element is balanced"
-  (define split-left-balanced-w/o-inserted
-    (call/split
-     call-w/o-inserted
-     (lambda (new-left found? new-right)
-       (balanced? new-left))))
-  (test-property split-left-balanced-w/o-inserted (list (split-vector-generator))))
-
-(test-group "right tree from split without found element is balanced"
-  (define split-right-balanced-w/o-inserted
-    (call/split
-     call-w/o-inserted
-     (lambda (new-left found? new-right)
-       (balanced? new-right))))
-  (test-property split-right-balanced-w/o-inserted (list (split-vector-generator))))
-
-;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Union
-;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(test-group "union is balanced"
-  (define (union-balanced node1 node2)
-    (balanced? (union number-comparator node1 node2)))
-  (test-property union-balanced
-                 (list (vector->node-generator)
-                       (vector->node-generator))))
-
-(define (union-subset-of-lset node1 node2)
-    (let ((node (union number-comparator node1 node2))
-          (union (lset-union =
-                             (node->in-order-list node1)
-                             (node->in-order-list node2))))
-      (if (verbose)
-          (dynamic-property-set! 'union
-                                 (node->in-order-list node)))
-      (every (cut search number-comparator <> node) union)))
-
-(test-group "union subset of lset"
-  (parameterize ((verbose #t))
-    (test-property union-subset-of-lset
-                   (list (vector->node-generator)
-                         (vector->node-generator)))))
-
-(test-group "union subset of lset, right null"
-  (test-property union-subset-of-lset
-                 (list (vector->node-generator)
-                       (circular-generator '()))))
-
-(test-group "union subset of lset, left null"
-  (test-property union-subset-of-lset
-                 (list (circular-generator '())
-                       (vector->node-generator))))
-
-(define (lset-subset-of-union node1 node2)
-  (let ((node (union number-comparator node1 node2))
-        (union (lset-union =
-                           (node->in-order-list node1)
-                           (node->in-order-list node2))))
-    (node-every (cut memq <> union) node)))
-
-(test-group "lset subset of union"
-  (test-property lset-subset-of-union
-                 (list (vector->node-generator)
-                       (vector->node-generator))))
-
-(test-group "lset subset of union, right null"
-  (test-property lset-subset-of-union
-                 (list (vector->node-generator)
-                       (circular-generator '()))))
-
-(test-group "lset subset of union, left null"
-  (test-property lset-subset-of-union
-                 (list (circular-generator '())
-                       (vector->node-generator))))
-
-;;; ;;;;;;;;;;;;;;;;;;;;
-;;; Intersection
-;;; ;;;;;;;;;;;;;;;;;;;;
-
-(test-group "intersection balanced?"
-  (define (intersection-balanced? node1 node2)
-    (balanced? (intersection number-comparator node1 node2)))
-  (test-property intersection-balanced?
-                 (list (vector->node-generator)
-                       (vector->node-generator))))
-
-(test-group "intersection of itself"
-  (define (intersection-of-itself node1)
-    (let ((node (intersection number-comparator node1 node1))
-          (lst (node->in-order-list node1)))
-      (every (cut search number-comparator <> node) lst)))
-  (test-property intersection-of-itself
-                 (list (vector->node-generator))))
-
-(test-group "intersection of null, left"
-  (define (intersection-of-null-left node1)
-    (null? (intersection number-comparator node1 '())))
-  (test-property intersection-of-null-left
-                 (list (vector->node-generator))))
-
-(test-group "intersection of null, right"
-  (define (intersection-of-null-right node1)
-    (null? (intersection number-comparator '() node1)))
-  (test-property intersection-of-null-right 
-                 (list (vector->node-generator))))
-
-(test-group "intersection subset of lset"
-  (define (intersection-lset node1 node2)
-    (let ((node (intersection number-comparator node1 node2))
-          (intersection (lset-intersection =
-                                           (node->in-order-list node1)
-                                           (node->in-order-list node2))))
-      (every (cut search number-comparator <> node) intersection)))
-  (test-property intersection-lset
-                 (list (vector->node-generator)
-                       (vector->node-generator))))
-
-(test-group "lset subset of intersection"
-  (define (lset-subset-of-intersection node1 node2)
-    (let ((node (intersection number-comparator node1 node2))
-          (intersection (lset-intersection =
-                                           (node->in-order-list node1)
-                                           (node->in-order-list node2))))
-      (node-every (cut memv <> intersection) node)))
-  (test-property lset-subset-of-intersection
-                 (list (vector->node-generator)
-                       (vector->node-generator))))
-
-;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Difference
-;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(test-group "difference balanced?"
-  (define (difference-balanced? node1 node2)
-    (balanced? (difference number-comparator node1 node2)))
-  (test-property difference-balanced?
-                 (list (vector->node-generator)
-                       (vector->node-generator))))
-
-(test-group "difference subset of lset"
-  (define (difference-subset-of-lset node1 node2)
-    (let ((node (difference number-comparator node1 node2))
-          (intersection (lset-difference =
-                                         (node->in-order-list node1)
-                                         (node->in-order-list node2))))
-      (every (cut search number-comparator <> node) intersection)))
-  (test-property difference-subset-of-lset
-                 (list (vector->node-generator)
-                       (vector->node-generator))))
-
-(test-group "lset subset of difference"
-  (define (lset-subset-of-difference node1 node2)
-    (let ((node (difference number-comparator node1 node2))
-          (intersection (lset-difference =
-                                         (node->in-order-list node1)
-                                         (node->in-order-list node2))))
-      (node-every (cut memq <> intersection) node)))
-  (test-property lset-subset-of-difference
-                 (list (vector->node-generator)
-                       (vector->node-generator))))
-
-;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Update
-;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define %insert insert)
-(define (insert elem set)
-  (%insert number-comparator
-           set
-           elem))
-
-(test-group "update of unordered list is balanced"
-  (define (insert-unordered lst)
-    (let ((set (fold insert '() lst)))
-      (balanced? set)))
-  (test-property insert-unordered
-                 (list (list-generator-of
-                        (exact-integer-generator)))))
-
-(test-group "update of unordered list is subset of list"
-  (define (subset-of-list lst)
-    (let ((set (fold insert '() lst)))
-      (when (verbose)
-        (dynamic-property-set! 'lst lst)
-        (dynamic-property-set! 'set (node->in-order-list set)))
-      (every (cut search number-comparator <> set) lst)))
-  (parameterize ((verbose #f))
-    (test-property subset-of-list
-                   (list (list-generator-of
-                          (exact-integer-generator))))))
-
-(test-group "list is subset of update of unordered list"
-  (define (list-is-subset-of lst)
-    (let ((set (fold insert '() lst)))
-      (node-every (cut memq <> lst) set)))
-  (test-property list-is-subset-of
-                 (list (list-generator-of
-                        (exact-integer-generator)))))
-
-;;; ;;;;;;;;;;;;;;;;
-;;; Delete
-;;; ;;;;;;;;;;;;;;;;
-
-(define (call/difference procedure)
-  (lambda (lst1 lst2)
-    (let* ((set1 (fold insert '() lst1))
-           (set2 (fold insert '() lst2))
-           (diff (difference number-comparator set1 set2))
-           (deleted (fold (lambda (elem set)
-                            (when (verbose)
-                              (dynamic-property-set! 'elem elem)
-                              (dynamic-property-set! 'set set))
-                            (delete number-comparator set elem))
-                          set1
-                          lst2)))
-      (procedure lst1 lst2 diff deleted))))
-
-(test-group "delete of elements unordered list is balanced"
-  (define (delete-balanced? lst1 lst2)
-    (let* ((set (fold insert '() lst1))
-           (deleted (fold (lambda (elem set)
-                            (delete number-comparator set elem))
-                          set
-                          lst2)))
-      (balanced? deleted)))
-  (test-property delete-balanced?
-                 (list (list-generator-of (exact-integer-generator))
-                       (list-generator-of (exact-integer-generator)))))
-
-(test-group "delete of two sets is subset of difference"
-  (define (delete-and-difference lst1 lst2 diff deleted)
-    (node-every (cut search number-comparator <> diff) deleted))
-  (parameterize ((verbose #f))
-    (test-property (call/difference delete-and-difference)
-                   (list (list-generator-of (exact-integer-generator))
-                         (list-generator-of (exact-integer-generator))))))
-
-(test-group "difference is subset of delete of two sets"
-  (define (difference-and-delete lst1 lst2 diff deleted)
-    (node-every (cut search number-comparator <> deleted) diff))
-  (test-property (call/difference difference-and-delete)
-                 (list (list-generator-of (exact-integer-generator))
-                       (list-generator-of (exact-integer-generator)))))
-
-;;; ;;;;;;;;;;;;;;;;;;;;;;;
-;;; xor
-;;; ;;;;;;;;;;;;;;;;;;;;;;;
-
-(test-group "xor balanced?"
-  (define (xor-balanced? node1 node2)
-    (balanced? (xor number-comparator node1 node2)))
-  (test-property xor-balanced?
-                 (list (vector->node-generator) (vector->node-generator))))
-
-(test-group "lset subset of xor"
-  (define (lset-subset-of-xor lst1 lst2)
-    (let* ((node1 (fold insert '() lst1))
-           (node2 (fold insert '() lst2))
-           (set-xor (xor number-comparator node1 node2))
-           (list-xor (lset-xor = lst1 lst2)))
-      (every (cut search number-comparator <> set-xor) list-xor)))
-  (test-property lset-subset-of-xor
-                 (list (list-generator-of (exact-integer-generator))
-                       (list-generator-of (exact-integer-generator)))))
-
-(test-group "xor subset of lset"
-  (define (xor-subset-of-lset lst1 lst2)
-    (let* ((node1 (fold insert '() lst1))
-           (node2 (fold insert '() lst2))
-           (set-xor (xor number-comparator node1 node2))
-           (list-xor (lset-xor = lst1 lst2)))
-      (node-every (cut member <> list-xor) set-xor)))
-  (test-property xor-subset-of-lset
-                 (list (list-generator-of (exact-integer-generator))
-                       (list-generator-of (exact-integer-generator)))))
-
-;;; ;;;;;;;;;;
-;;; Generators
-;;; ;;;;;;;;;;
-
-(test-group "node->generator"
-  (define (node->generator-works lst)
-    (let* ((node (fold insert '() lst))
-           (result-lst
-            (generator->list (node->generator node))))
-      (lset= = lst result-lst)))
-  (test-property node->generator-works
-                 (list (list-generator-of (exact-integer-generator)))))
-
-(test-group "generator->node"
-  (define (generator->node-works lst)
-    (let* ((gen (list->generator lst))
-           (node (generator->node number-comparator gen)))
-      (and (node-every (cut member <> lst) node)
-           (every (cut search number-comparator <> node) lst))))
-  (test-property generator->node-works
-                 (list (list-generator-of (exact-integer-generator)))))
-
-(test-group "node->in-order-generator"
-  (define (node->in-order-generator-works lst)
-    (let* ((node (fold insert '() lst))
-           (result-lst (generator->list
-                        (node->in-order-generator node))))
-      (and (lset= = lst result-lst)
-           (list-sorted? < result-lst))))
-  (test-property node->in-order-generator-works
-                 (list (list-generator-of (exact-integer-generator)))))
-
-(test-group "node->reverse-order-generator"
-  (define (node->reverse-order-generator-works lst)
-    (let* ((node (fold insert '() lst))
-           (result-lst (generator->list
-                        (node->reverse-order-generator node))))
-      (and (lset= = lst result-lst)
-           (list-sorted? > result-lst))))
-  (test-property node->reverse-order-generator-works
-                 (list (list-generator-of (exact-integer-generator)))))
+#;(begin
+  (define-library (mcgoron weight-balanced-trees test internal)
+    (import (scheme base)
+            (chicken condition)
+            (mcgoron weight-balanced-trees test util)
+            (mcgoron weight-balanced-trees test random-number-vector)
+            (except (mcgoron srfi 64) factory)
+            (srfi 1) (srfi 26) (srfi 64) (srfi 128) (srfi 132) (srfi 133)
+            (srfi 158) (srfi 194) (srfi 197) (srfi 252)
+            (except (mcgoron weight-balanced-trees internal)
+                    every)
+            (prefix (only (mcgoron weight-balanced-trees internal)
+                          every)
+                    node-))
+    (include "internal.scm"))
+  (import (mcgoron weight-balanced-trees test internal)))
+
+(define-library (mcgoron weight-balanced-trees test srfi 113 sets)
+  (import (scheme base)
+          (chicken condition)
+          (except (mcgoron srfi 64) factory)
+          (srfi 1) (srfi 26) (srfi 64) (srfi 128)
+          (srfi 158) (srfi 194) (srfi 252)
+          (mcgoron weight-balanced-trees srfi 113 sets))
+  (include "srfi-113-sets.scm"))
 
diff --git a/tests/srfi-113-sets.scm b/tests/srfi-113-sets.scm
new file mode 100644
index 0000000..edb6334
--- /dev/null
+++ b/tests/srfi-113-sets.scm
@@ -0,0 +1,71 @@
+#| Copyright 2024 Peter McGoron
+ |
+ | Licensed under the Apache License, Version 2.0 (the "License");
+ | you may not use this file except in compliance with the License.
+ | You may obtain a copy of the License at
+ |
+ |     http://www.apache.org/licenses/LICENSE-2.0
+ |
+ | Unless required by applicable law or agreed to in writing, software
+ | distributed under the License is distributed on an "AS IS" BASIS,
+ | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ | See the License for the specific language governing permissions and
+ | limitations under the License.
+ |#
+
+(import (mcgoron weight-balanced-trees srfi 113 sets)
+        (srfi 252)
+        (srfi 64))
+
+(define (orderable-generator)
+  ;; Return a value that can be ordered in an obvious way.
+  (gsampling #;(boolean-generator)
+             (real-generator)
+             #;(char-generator)
+             #;(string-generator)
+             #;(bytevector-generator)))
+
+(test-group "multiple element set using `set` procedure"
+  (define (multiple-element-set lst)
+    (let* ((new-set (apply set (make-default-comparator) lst))
+           (set-as-list (set->list new-set)))
+      (test-assert "set?" (set? new-set))
+      (test-assert "empty?" (if (null? lst)
+                                (set-empty? new-set)
+                                (not (set-empty? new-set))))
+      ;; The new-set will remove duplicates.
+      (test-assert "length?" (<= (set-size new-set) (length lst)))
+      (test-assert "subset of inserted" (lset<= equal? set-as-list lst))))
+  (test-property multiple-element-set
+                 (list (list-generator-of (orderable-generator)))))
+
+(define (remove-duplicates generator)
+  (gmap (lambda (lst)
+          (let ((cmp (make-default-comparator)))
+            (let loop ((seen '())
+                       (lst lst))
+              (cond
+                ((null? lst) seen)
+                ((member (car lst)
+                         seen
+                         (cut =? cmp <> <>))
+                 (loop seen (cdr lst)))
+                (else (loop (cons (car lst) seen) (cdr lst)))))))
+        generator))
+
+(test-group "multiple element set using `set` procedure, unique elements"
+  (define (multiple-element-set lst)
+    (let* ((new-set (apply set (make-default-comparator) lst))
+           (set-as-list (set->list new-set)))
+      (test-assert "set?" (set? new-set))
+      (test-assert "empty?" (if (null? lst)
+                                (set-empty? new-set)
+                                (not (set-empty? new-set))))
+      (dynamic-property-set! 'set set-as-list)
+      (dynamic-property-set! 'list lst)
+      (test-equal "length?" (set-size new-set) (length lst))
+      (test-assert "exactly inserted" (lset= equal? set-as-list lst))))
+  (test-property multiple-element-set
+                 (list (remove-duplicates
+                        (list-generator-of
+                         (orderable-generator))))))
diff --git a/weight-balanced-trees.egg b/weight-balanced-trees.egg
index 470ca73..3243bc1 100644
--- a/weight-balanced-trees.egg
+++ b/weight-balanced-trees.egg
@@ -1,12 +1,18 @@
 ((author "Peter McGoron")
  (version "0.1.0")
  (synopsis "Persistent weight balanced trees")
- (category "data")
+ (category data)
  (license "Apache-2.0")
- (dependencies "r7rs" "srfi-128")
- (test-dependencies "srfi-133" "srfi-132" "srfi-194" "srfi-132" "srfi-128" "srfi-1" "srfi-64" "srfi-252" "srfi-158" "sexpr-srfi-64-runner" "srfi-197")
+ (dependencies r7rs srfi-1 srfi-128 srfi-158)
+ (test-dependencies srfi-133 srfi-132 srfi-194 srfi-132 srfi-128 srfi-1 srfi-64 srfi-252 srfi-158 sexpr-srfi-64-runner srfi-197)
  (components (extension mcgoron.weight-balanced-trees.internal
                (source "mcgoron/weight-balanced-trees/internal.sld")
                (types-file)
                (source-dependencies "mcgoron/weight-balanced-trees/internal.scm")
+               (csc-options "-O3" "-R" "r7rs" "-X" "r7rs")))
+ (components (extension mcgoron.weight-balanced-trees.srfi.113.sets
+               (source "mcgoron/weight-balanced-trees/srfi/113/sets.sld")
+               (types-file)
+               (source-dependencies "mcgoron/weight-balanced-trees/srfi/113/sets.scm")
+               (component-dependencies mcgoron.weight-balanced-trees.internal)
                (csc-options "-O3" "-R" "r7rs" "-X" "r7rs"))))