diff --git a/srfi/sets/comparators-shim.scm b/srfi/sets/comparators-shim.scm
new file mode 100644
index 00000000..2d043011
--- /dev/null
+++ b/srfi/sets/comparators-shim.scm
@@ -0,0 +1,91 @@
+;;; Below are some default comparators provided by SRFI-114,
+;;; but not SRFI-128, which this SRFI has transitioned to
+;;; depend on. See the rationale for SRFI-128 as to why it is
+;;; preferred in usage compared to SRFI-114.
+
+;; Most if not all of this code is taken from SRFI-114
+
+; (define exact inexact->exact)
+
+(define string-foldcase string-downcase)
+
+(define (make-comparison=/< = <)
+  (lambda (a b)
+    (cond
+      ((= a b) 0)
+      ((< a b) -1)
+      (else 1))))
+
+;; Comparison procedure for real numbers only
+(define (real-comparison a b)
+  (cond
+    ((< a b) -1)
+    ((> a b) 1)
+    (else 0)))
+
+;; Comparison procedure for non-real numbers.
+(define (complex-comparison a b)
+  (let ((real-result (real-comparison (real-part a) (real-part b))))
+    (if (= real-result 0)
+      (real-comparison (imag-part a) (imag-part b))
+      real-result)))
+
+(define (number-hash obj) (exact (abs obj)))
+
+(define number-comparator
+  (make-comparator number? = complex-comparison number-hash))
+
+(define char-comparison (make-comparison=/< char=? char<?))
+
+(define (char-hash obj) (abs (char->integer obj)))
+
+(define char-comparator
+  (make-comparator char? char=? char-comparison char-hash))
+
+;; Makes a hash function that works vectorwise
+(define limit (expt 2 20))
+
+(define (make-vectorwise-hash hash length ref)
+  (lambda (obj)
+    (let loop ((index (- (length obj) 1)) (result 5381))
+      (if (= index 0)
+        result
+        (let* ((prod (modulo (* result 33) limit))
+               (sum (modulo (+ prod (hash (ref obj index))) limit)))
+          (loop (- index 1) sum))))))
+
+(define string-hash
+  (make-vectorwise-hash char-hash string-length string-ref))
+
+(define string-comparison (make-comparison=/< string=? string<?))
+
+(define string-ci-comparison (make-comparison=/< string-ci=? string-ci<?))
+
+(define string-comparator
+  (make-comparator string? string=? string-comparison string-hash))
+
+(define (string-ci-hash obj) (string-hash (string-foldcase obj)))
+
+(define string-ci-comparator
+  (make-comparator string? string-ci=? string-ci-comparison string-ci-hash))
+
+(define eq-comparator
+  (make-comparator
+    #t
+    eq?
+    #f
+    default-hash))
+
+(define eqv-comparator
+  (make-comparator
+    #t
+    eqv?
+    #f
+    default-hash))
+
+(define equal-comparator
+  (make-comparator
+    #t
+    equal?
+    #f
+    default-hash))
diff --git a/srfi/sets/sets-impl.scm b/srfi/sets/sets-impl.scm
new file mode 100644
index 00000000..74ff337b
--- /dev/null
+++ b/srfi/sets/sets-impl.scm
@@ -0,0 +1,1300 @@
+;;;; Implementation of general sets and bags for SRFI 113
+
+;;; A "sob" object is the representation of both sets and bags.
+;;; This allows each set-* and bag-* procedure to be implemented
+;;; using the same code, without having to deal in ugly indirections
+;;; over the field accessors.  There are three fields, "sob-multi?",
+;;; "sob-hash-table", and "sob-comparator."
+
+;;; The value of "sob-multi?" is #t for bags and #f for sets.
+;;; "Sob-hash-table" maps the elements of the sob to the number of times
+;;; the element appears, which is always 1 for a set, any positive value
+;;; for a bag.  "Sob-comparator" is the comparator for the elements of
+;;; the set.
+
+;;; Note that sob-* procedures do not do type checking or (typically) the
+;;; copying required for supporting pure functional update.  These things
+;;; are done by the set-* and bag-* procedures, which are externally
+;;; exposed (but trivial and mostly uncommented below).
+
+
+;;; Shim to convert from SRFI 69 to the future "intermediate hash tables"
+;;; SRFI.  Unfortunately, hash-table-fold is incompatible between the two
+;;; and so is not usable.
+
+;; This will be just "make-hash-table" in future.
+
+(define (make-hash-table/comparator comparator)
+  (make-hash-table (comparator-equality-predicate comparator)
+                   (modulizer (comparator-hash-function comparator))))
+
+;; These two procedures adjust for the mismatch between the hash functions
+;; of SRFI 114, which return a potentially unbounded non-negative integer,
+;; and the hash functions of SRFI 69, which expect to be able to pass
+;; a second argument which is an upper bound.
+
+(define (modulizer hash-function)
+  (case-lambda
+    ((obj) (hash-function obj))
+    ((obj limit) (modulo (hash-function obj) limit))))
+
+;; Simple renaming.  Chicken's implementation of SRFI 69 provides
+;; hash-table-for-each as a non-standard extension, with the opposite
+;; order, so in the Chicken module we suppress importing it to muffle
+;; the conflict warning.
+
+(define hash-table-contains? hash-table-exists?)
+
+(define (hash-table-for-each proc hash-table)
+  (hash-table-walk hash-table proc))
+
+
+;;; Record definition and core typing/checking procedures
+
+(define-record-type sob
+  (raw-make-sob hash-table comparator multi?)
+  sob?
+  (hash-table sob-hash-table)
+  (comparator sob-comparator)
+  (multi? sob-multi?))
+
+(define (set? obj) (and (sob? obj) (not (sob-multi? obj))))
+
+(define (bag? obj) (and (sob? obj) (sob-multi? obj)))
+
+(define (check-set obj) (if (not (set? obj)) (error "not a set" obj)))
+
+(define (check-bag obj) (if (not (bag? obj)) (error "not a bag" obj)))
+
+;; These procedures verify that not only are their arguments all sets
+;; or all bags as the case may be, but also share the same comparator.
+
+(define (check-all-sets list)
+  (for-each (lambda (obj) (check-set obj)) list)
+  (sob-check-comparators list))
+
+(define (check-all-bags list)
+  (for-each (lambda (obj) (check-bag obj)) list)
+  (sob-check-comparators list))
+
+(define (sob-check-comparators list)
+  (if (not (null? list))
+      (for-each
+        (lambda (sob)
+          (check-same-comparator (car list) sob))
+        (cdr list))))
+
+;; This procedure is used directly when there are exactly two arguments.
+
+(define (check-same-comparator a b)
+  (if (not (eq? (sob-comparator a) (sob-comparator b)))
+    (error "different comparators" a b)))
+
+;; This procedure defends against inserting an element
+;; into a sob that violates its constructor, since
+;; typical hash-table implementations don't check for us.
+
+(define (check-element sob element)
+  (comparator-check-type (sob-comparator sob) element))
+
+;;; Constructors
+
+;; Construct an arbitrary empty sob out of nothing.
+
+(define (make-sob comparator multi?)
+  (raw-make-sob (make-hash-table/comparator comparator) comparator multi?))
+
+;; Copy a sob, sharing the constructor.
+
+(define (sob-copy sob)
+  (raw-make-sob (hash-table-copy (sob-hash-table sob))
+            (sob-comparator sob)
+            (sob-multi? sob)))
+
+(define (set-copy set)
+  (check-set set)
+  (sob-copy set))
+
+(define (bag-copy bag)
+  (check-bag bag)
+  (sob-copy bag))
+
+;; Construct an empty sob that shares the constructor of an existing sob.
+
+(define (sob-empty-copy sob)
+  (make-sob (sob-comparator sob) (sob-multi? sob)))
+
+;; Construct a set or a bag and insert elements into it.  These are the
+;; simplest external constructors.
+
+(define (set comparator . elements)
+  (let ((result (make-sob comparator #f)))
+    (for-each (lambda (x) (sob-increment! result x 1)) elements)
+    result))
+
+(define (bag comparator . elements)
+  (let ((result (make-sob comparator #t)))
+    (for-each (lambda (x) (sob-increment! result x 1)) elements)
+    result))
+
+;; The fundamental (as opposed to simplest) constructor: unfold the
+;; results of iterating a function as a set.  In line with SRFI 1,
+;; we provide an opportunity to map the sequence of seeds through a
+;; mapper function.
+
+(define (sob-unfold stop? mapper successor seed comparator multi?)
+  (let ((result (make-sob comparator multi?)))
+    (let loop ((seed seed))
+      (if (stop? seed)
+          result
+          (begin
+            (sob-increment! result (mapper seed) 1)
+            (loop (successor seed)))))))
+
+(define (set-unfold continue? mapper successor seed comparator)
+  (sob-unfold continue? mapper successor seed comparator #f))
+
+(define (bag-unfold continue? mapper successor seed comparator)
+  (sob-unfold continue? mapper successor seed comparator #t))
+
+;;; Predicates
+
+;; Just a wrapper of hash-table-contains?.
+
+(define (sob-contains? sob member)
+  (hash-table-contains? (sob-hash-table sob) member))
+
+(define (set-contains? set member)
+  (check-set set)
+  (sob-contains? set member))
+
+(define (bag-contains? bag member)
+  (check-bag bag)
+  (sob-contains? bag member))
+
+;; A sob is empty if its size is 0.
+
+(define (sob-empty? sob)
+  (= 0 (hash-table-size (sob-hash-table sob))))
+
+(define (set-empty? set)
+  (check-set set)
+  (sob-empty? set))
+
+(define (bag-empty? bag)
+  (check-bag bag)
+  (sob-empty? bag))
+
+;; Two sobs are disjoint if, when looping through one, we can't find
+;; any of its elements in the other.  We have to try both ways:
+;; sob-half-disjoint checks just one direction for simplicity.
+
+(define (sob-half-disjoint? a b)
+  (let ((ha (sob-hash-table a))
+        (hb (sob-hash-table b)))
+    (call/cc
+      (lambda (return)
+        (hash-table-for-each
+          (lambda (key val) (if (hash-table-contains? hb key) (return #f)))
+          ha)
+      #t))))
+
+(define (set-disjoint? a b)
+  (check-set a)
+  (check-set b)
+  (check-same-comparator a b)
+  (and (sob-half-disjoint? a b) (sob-half-disjoint? b a)))
+
+(define (bag-disjoint? a b)
+  (check-bag a)
+  (check-bag b)
+  (check-same-comparator a b)
+  (and (sob-half-disjoint? a b) (sob-half-disjoint? b a)))
+
+;; Accessors
+
+;; If two objects are indistinguishable by the comparator's
+;; equality procedure, only one of them will be represented in the sob.
+;; This procedure lets us find out which one it is; it will return
+;; the value stored in the sob that is equal to the element.
+;; Note that we have to search the whole hash table item by item.
+;; The default is returned if there is no such element.
+
+(define (sob-member sob element default)
+  (define (same? a b) (=? (sob-comparator sob) a b))
+  (call/cc
+    (lambda (return)
+      (hash-table-for-each
+        (lambda (key val) (if (same? key element) (return key)))
+        (sob-hash-table sob))
+      default)))
+
+(define (set-member set element default)
+  (check-set set)
+  (sob-member set element default))
+
+(define (bag-member bag element default)
+  (check-bag bag)
+  (sob-member bag element default))
+
+;; Retrieve the comparator.
+
+(define (set-element-comparator set)
+  (check-set set)
+  (sob-comparator set))
+
+(define (bag-element-comparator bag)
+  (check-bag bag)
+  (sob-comparator bag))
+
+
+;; Updaters (pure functional and linear update)
+
+;; The primitive operation for adding an element to a sob.
+;; There are a few cases where we bypass this for efficiency.
+
+(define (sob-increment! sob element count)
+  (check-element sob element)
+  (hash-table-update!/default
+    (sob-hash-table sob)
+    element
+    (if (sob-multi? sob)
+      (lambda (value) (+ value count))
+      (lambda (value) 1))
+    0))
+
+;; The primitive operation for removing an element from a sob.  Note this
+;; procedure is incomplete: it allows the count of an element to drop below 1.
+;; Therefore, whenever it is used it is necessary to call sob-cleanup!
+;; to fix things up.  This is done because it is unsafe to remove an
+;; object from a hash table while iterating through it.
+
+(define (sob-decrement! sob element count)
+  (hash-table-update!/default
+    (sob-hash-table sob)
+    element
+    (lambda (value) (- value count))
+    0))
+
+;; This is the cleanup procedure, which happens in two passes: it
+;; iterates through the sob, deciding which elements to remove (those
+;; with non-positive counts), and collecting them in a list.  When the
+;; iteration is done, it is safe to remove the elements using the list,
+;; because we are no longer iterating over the hash table.  It returns
+;; its argument, because it is often tail-called at the end of some
+;; procedure that wants to return the clean sob.
+
+(define (sob-cleanup! sob)
+  (let ((ht (sob-hash-table sob)))
+    (for-each (lambda (key) (hash-table-delete! ht key))
+              (nonpositive-keys ht))
+    sob))
+
+(define (nonpositive-keys ht)
+  (let ((result '()))
+    (hash-table-for-each
+      (lambda (key value)
+        (when (<= value 0)
+          (set! result (cons key result))))
+      ht)
+    result))
+
+;; We expose these for bags but not sets.
+
+(define (bag-increment! bag element count)
+  (check-bag bag)
+  (sob-increment! bag element count)
+  bag)
+
+(define (bag-decrement! bag element count)
+  (check-bag bag)
+  (sob-decrement! bag element count)
+  (sob-cleanup! bag)
+  bag)
+
+;; The primitive operation to add elements from a list.  We expose
+;; this two ways: with a list argument and with multiple arguments.
+
+(define (sob-adjoin-all! sob elements)
+  (for-each
+    (lambda (elem)
+      (sob-increment! sob elem 1))
+    elements))
+
+(define (set-adjoin! set . elements)
+  (check-set set)
+  (sob-adjoin-all! set elements)
+  set)
+
+(define (bag-adjoin! bag . elements)
+  (check-bag bag)
+  (sob-adjoin-all! bag elements)
+  bag)
+
+
+;; These versions copy the set or bag before adjoining.
+
+(define (set-adjoin set . elements)
+  (check-set set)
+  (let ((result (sob-copy set)))
+    (sob-adjoin-all! result elements)
+    result))
+
+(define (bag-adjoin bag . elements)
+  (check-bag bag)
+  (let ((result (sob-copy bag)))
+    (sob-adjoin-all! result elements)
+    result))
+
+;; Given an element which resides in a set, this makes sure that the
+;; specified element is represented by the form given.  Thus if a
+;; sob contains 2 and the equality predicate is =, then calling
+;; (sob-replace! sob 2.0) will replace the 2 with 2.0.  Does nothing
+;; if there is no such element in the sob.
+
+(define (sob-replace! sob element)
+  (let* ((comparator (sob-comparator sob))
+         (= (comparator-equality-predicate comparator))
+         (ht (sob-hash-table sob)))
+    (comparator-check-type comparator element)
+    (call/cc
+      (lambda (return)
+        (hash-table-for-each
+          (lambda (key value)
+            (when (= key element)
+              (hash-table-delete! ht key)
+              (hash-table-set! ht element value)
+              (return sob)))
+          ht)
+        sob))))
+
+(define (set-replace! set element)
+  (check-set set)
+  (sob-replace! set element)
+  set)
+
+(define (bag-replace! bag element)
+  (check-bag bag)
+  (sob-replace! bag element)
+  bag)
+
+;; Non-destructive versions that copy the set first.  Yes, a little
+;; bit inefficient because it copies the element to be replaced before
+;; actually replacing it.
+
+(define (set-replace set element)
+  (check-set set)
+  (let ((result (sob-copy set)))
+    (sob-replace! result element)
+    result))
+
+(define (bag-replace bag element)
+  (check-bag bag)
+  (let ((result (sob-copy bag)))
+    (sob-replace! result element)
+    result))
+
+;; The primitive operation to delete elemnets from a list.
+;; Like sob-adjoin-all!, this is exposed two ways.  It calls
+;; sob-cleanup! itself, so its callers don't need to (though it is safe
+;; to do so.)
+
+(define (sob-delete-all! sob elements)
+  (for-each (lambda (element) (sob-decrement! sob element 1)) elements)
+  (sob-cleanup! sob)
+  sob)
+
+(define (set-delete! set . elements)
+  (check-set set)
+  (sob-delete-all! set elements))
+
+(define (bag-delete! bag . elements)
+  (check-bag bag)
+  (sob-delete-all! bag elements))
+
+(define (set-delete-all! set elements)
+  (check-set set)
+  (sob-delete-all! set elements))
+
+(define (bag-delete-all! bag elements)
+  (check-bag bag)
+  (sob-delete-all! bag elements))
+
+;; Non-destructive version copy first; this is inefficient.
+
+(define (set-delete set . elements)
+  (check-set set)
+  (sob-delete-all! (sob-copy set) elements))
+
+(define (bag-delete bag . elements)
+  (check-bag bag)
+  (sob-delete-all! (sob-copy bag) elements))
+
+(define (set-delete-all set elements)
+  (check-set set)
+  (sob-delete-all! (sob-copy set) elements))
+
+(define (bag-delete-all bag elements)
+  (check-bag bag)
+  (sob-delete-all! (sob-copy bag) elements))
+
+;; Flag used by sob-search! to represent a missing object.
+
+(define missing (string-copy "missing"))
+
+;; Searches and then dispatches to user-defined procedures on failure
+;; and success, which in turn should reinvoke a procedure to take some
+;; action on the set (insert, ignore, replace, or remove).
+
+(define (sob-search! sob element failure success)
+  (define (insert obj)
+    (sob-increment! sob element 1)
+    (values sob obj))
+  (define (ignore obj)
+    (values sob obj))
+  (define (update new-elem obj)
+    (sob-decrement! sob element 1)
+    (sob-increment! sob new-elem 1)
+    (values (sob-cleanup! sob) obj))
+  (define (remove obj)
+    (sob-decrement! sob element 1)
+    (values (sob-cleanup! sob) obj))
+  (let ((true-element (sob-member sob element missing)))
+    (if (eq? true-element missing)
+      (failure insert ignore)
+      (success true-element update remove))))
+
+(define (set-search! set element failure success)
+  (check-set set)
+  (sob-search! set element failure success))
+
+(define (bag-search! bag element failure success)
+  (check-bag bag)
+  (sob-search! bag element failure success))
+
+;; Return the size of a sob.  If it's a set, we can just use the
+;; number of associations in the hash table, but if it's a bag, we
+;; have to add up the counts.
+
+(define (sob-size sob)
+  (if (sob-multi? sob)
+    (let ((result 0))
+      (hash-table-for-each
+        (lambda (elem count) (set! result (+ count result)))
+        (sob-hash-table sob))
+      result)
+    (hash-table-size (sob-hash-table sob))))
+
+(define (set-size set)
+  (check-set set)
+  (sob-size set))
+
+(define (bag-size bag)
+  (check-bag bag)
+  (sob-size bag))
+
+;; Search a sob to find something that matches a predicate.  You don't
+;; know which element you will get, so this is not as useful as finding
+;; an element in a list or other ordered container.  If it's not there,
+;; call the failure thunk.
+
+(define (sob-find pred sob failure)
+  (call/cc
+    (lambda (return)
+      (hash-table-for-each
+        (lambda (key value)
+          (if (pred key) (return key)))
+        (sob-hash-table sob))
+    (failure))))
+
+(define (set-find pred set failure)
+  (check-set set)
+  (sob-find pred set failure))
+
+(define (bag-find pred bag failure)
+  (check-bag bag)
+  (sob-find pred bag failure))
+
+;; Count the number of elements in the sob that satisfy the predicate.
+;; This is a special case of folding.
+
+(define (sob-count pred sob)
+  (sob-fold
+    (lambda (elem total) (if (pred elem) (+ total 1) total))
+    0
+    sob))
+
+(define (set-count pred set)
+  (check-set set)
+  (sob-count pred set))
+
+(define (bag-count pred bag)
+  (check-bag bag)
+  (sob-count pred bag))
+
+;; Check if any of the elements in a sob satisfy a predicate.  Breaks out
+;; early (with call/cc) if a success is found.
+
+(define (sob-any? pred sob)
+  (call/cc
+    (lambda (return)
+      (hash-table-for-each
+        (lambda (elem value) (if (pred elem) (return #t)))
+        (sob-hash-table sob))
+      #f)))
+
+(define (set-any? pred set)
+  (check-set set)
+  (sob-any? pred set))
+
+(define (bag-any? pred bag)
+  (check-bag bag)
+  (sob-any? pred bag))
+
+;; Analogous to set-any?.  Breaks out early if a failure is found.
+
+(define (sob-every? pred sob)
+  (call/cc
+    (lambda (return)
+      (hash-table-for-each
+        (lambda (elem value) (if (not (pred elem)) (return #f)))
+        (sob-hash-table sob))
+      #t)))
+
+(define (set-every? pred set)
+  (check-set set)
+  (sob-every? pred set))
+
+(define (bag-every? pred bag)
+  (check-bag bag)
+  (sob-every? pred bag))
+
+
+;;; Mapping and folding
+
+;; A utility for iterating a command n times.  This is used by sob-for-each
+;; to execute a procedure over the repeated elements in a bag.  Because
+;; of the representation of sets, it works for them too.
+
+(define (do-n-times cmd n)
+  (let loop ((n n))
+    (when (> n 0)
+      (cmd)
+      (loop (- n 1)))))
+
+;; Basic iterator over a sob.
+
+(define (sob-for-each proc sob)
+  (hash-table-for-each
+    (lambda (key value) (do-n-times (lambda () (proc key)) value))
+    (sob-hash-table sob)))
+
+(define (set-for-each proc set)
+  (check-set set)
+  (sob-for-each proc set))
+
+(define (bag-for-each proc bag)
+  (check-bag bag)
+  (sob-for-each proc bag))
+
+;; Fundamental mapping operator.  We map over the associations directly,
+;; because each instance of an element in a bag will be treated identically
+;; anyway; we insert them all at once with sob-increment!.
+
+(define (sob-map comparator proc sob)
+  (let ((result (make-sob comparator (sob-multi? sob))))
+    (hash-table-for-each
+      (lambda (key value) (sob-increment! result (proc key) value))
+      (sob-hash-table sob))
+    result))
+
+(define (set-map comparator proc set)
+  (check-set set)
+  (sob-map comparator proc set))
+
+(define (bag-map comparator proc bag)
+  (check-bag bag)
+  (sob-map comparator proc bag))
+
+;; The fundamental deconstructor.  Note that there are no left vs. right
+;; folds because there is no order.  Each element in a bag is fed into
+;; the fold separately.
+
+(define (sob-fold proc nil sob)
+  (let ((result nil))
+    (sob-for-each
+      (lambda (elem) (set! result (proc elem result)))
+      sob)
+    result))
+
+(define (set-fold proc nil set)
+  (check-set set)
+  (sob-fold proc nil set))
+
+(define (bag-fold proc nil bag)
+  (check-bag bag)
+  (sob-fold proc nil bag))
+
+;; Process every element and copy the ones that satisfy the predicate.
+;; Identical elements are processed all at once.  This is used for both
+;; filter and remove.
+
+(define (sob-filter pred sob)
+  (let ((result (sob-empty-copy sob)))
+    (hash-table-for-each
+      (lambda (key value)
+        (if (pred key) (sob-increment! result key value)))
+      (sob-hash-table sob))
+    result))
+
+(define (set-filter pred set)
+  (check-set set)
+  (sob-filter pred set))
+
+(define (bag-filter pred bag)
+  (check-bag bag)
+  (sob-filter pred bag))
+
+(define (set-remove pred set)
+  (check-set set)
+  (sob-filter (lambda (x) (not (pred x))) set))
+
+(define (bag-remove pred bag)
+  (check-bag bag)
+  (sob-filter (lambda (x) (not (pred x))) bag))
+
+;; Process each element and remove those that don't satisfy the filter.
+;; This does its own cleanup, and is used for both filter! and remove!.
+
+(define (sob-filter! pred sob)
+  (hash-table-for-each
+    (lambda (key value)
+      (if (not (pred key)) (sob-decrement! sob key value)))
+    (sob-hash-table sob))
+  (sob-cleanup! sob))
+
+(define (set-filter! pred set)
+  (check-set set)
+  (sob-filter! pred set))
+
+(define (bag-filter! pred bag)
+  (check-bag bag)
+  (sob-filter! pred bag))
+
+(define (set-remove! pred set)
+  (check-set set)
+  (sob-filter! (lambda (x) (not (pred x))) set))
+
+(define (bag-remove! pred bag)
+  (check-bag bag)
+  (sob-filter! (lambda (x) (not (pred x))) bag))
+
+;; Create two sobs and copy the elements that satisfy the predicate into
+;; one of them, all others into the other.  This is more efficient than
+;; filtering and removing separately.
+
+(define (sob-partition pred sob)
+  (let ((res1 (sob-empty-copy sob))
+        (res2 (sob-empty-copy sob)))
+    (hash-table-for-each
+      (lambda (key value)
+        (if (pred key)
+          (sob-increment! res1 key value)
+          (sob-increment! res2 key value)))
+      (sob-hash-table sob))
+    (values res1 res2)))
+
+(define (set-partition pred set)
+  (check-set set)
+  (sob-partition pred set))
+
+(define (bag-partition pred bag)
+  (check-bag bag)
+  (sob-partition pred bag))
+
+;; Create a sob and iterate through the given sob.  Anything that satisfies
+;; the predicate is left alone; anything that doesn't is removed from the
+;; given sob and added to the new sob.
+
+(define (sob-partition! pred sob)
+  (let ((result (sob-empty-copy sob)))
+    (hash-table-for-each
+      (lambda (key value)
+        (if (not (pred key))
+          (begin
+            (sob-decrement! sob key value)
+            (sob-increment! result key value))))
+      (sob-hash-table sob))
+    (values (sob-cleanup! sob) result)))
+
+(define (set-partition! pred set)
+  (check-set set)
+  (sob-partition! pred set))
+
+(define (bag-partition! pred bag)
+  (check-bag bag)
+  (sob-partition! pred bag))
+
+
+;;; Copying and conversion
+
+;;; Convert a sob to a list; a special case of sob-fold.
+
+(define (sob->list sob)
+  (sob-fold (lambda (elem list) (cons elem list)) '() sob))
+
+(define (set->list set)
+  (check-set set)
+  (sob->list set))
+
+(define (bag->list bag)
+  (check-bag bag)
+  (sob->list bag))
+
+;; Convert a list to a sob.  Probably could be done using unfold, but
+;; since sobs are mutable anyway, it's just as easy to add the elements
+;; by side effect.
+
+(define (list->sob! sob list)
+  (for-each (lambda (elem) (sob-increment! sob elem 1)) list)
+  sob)
+
+(define (list->set comparator list)
+  (list->sob! (make-sob comparator #f) list))
+
+(define (list->bag comparator list)
+  (list->sob! (make-sob comparator #t) list))
+
+(define (list->set! set list)
+  (check-set set)
+  (list->sob! set list))
+
+(define (list->bag! bag list)
+  (check-bag bag)
+  (list->sob! bag list))
+
+
+;;; Subsets
+
+;; All of these procedures follow the same pattern.  The
+;; sob<op>? procedures are case-lambdas that reduce the multi-argument
+;; case to the two-argument case.  As usual, the set<op>? and
+;; bag<op>? procedures are trivial layers over the sob<op>? procedure.
+;; The dyadic-sob<op>? procedures are where it gets interesting, so see
+;; the comments on them.
+
+(define sob=?
+  (case-lambda
+    ((sob) #t)
+    ((sob1 sob2) (dyadic-sob=? sob1 sob2))
+    ((sob1 sob2 . sobs)
+     (and (dyadic-sob=? sob1 sob2)
+          (apply sob=? sob2 sobs)))))
+
+(define (set=? . sets)
+  (check-all-sets sets)
+  (apply sob=? sets))
+
+(define (bag=? . bags)
+  (check-all-bags bags)
+  (apply sob=? bags))
+
+;; First we check that there are the same number of entries in the
+;; hashtables of the two sobs; if that's not true, they can't be equal.
+;; Then we check that for each key, the values are the same (where
+;; being absent counts as a value of 0).  If any values aren't equal,
+;; again they can't be equal.
+
+(define (dyadic-sob=? sob1 sob2)
+  (call/cc
+    (lambda (return)
+      (let ((ht1 (sob-hash-table sob1))
+            (ht2 (sob-hash-table sob2)))
+        (if (not (= (hash-table-size ht1) (hash-table-size ht2)))
+          (return #f))
+        (hash-table-for-each
+          (lambda (key value)
+            (if (not (= value (hash-table-ref/default ht2 key 0)))
+              (return #f)))
+          ht1))
+     #t)))
+
+(define sob<=?
+  (case-lambda
+    ((sob) #t)
+    ((sob1 sob2) (dyadic-sob<=? sob1 sob2))
+    ((sob1 sob2 . sobs)
+     (and (dyadic-sob<=? sob1 sob2)
+          (apply sob<=? sob2 sobs)))))
+
+(define (set<=? . sets)
+  (check-all-sets sets)
+  (apply sob<=? sets))
+
+(define (bag<=? . bags)
+  (check-all-bags bags)
+  (apply sob<=? bags))
+
+;; This is analogous to dyadic-sob=?, except that we have to check
+;; both sobs to make sure each value is <= in order to be sure
+;; that we've traversed all the elements in either sob.
+
+(define (dyadic-sob<=? sob1 sob2)
+  (call/cc
+    (lambda (return)
+      (let ((ht1 (sob-hash-table sob1))
+            (ht2 (sob-hash-table sob2)))
+        (if (not (<= (hash-table-size ht1) (hash-table-size ht2)))
+          (return #f))
+        (hash-table-for-each
+          (lambda (key value)
+            (if (not (<= value (hash-table-ref/default ht2 key 0)))
+              (return #f)))
+          ht1))
+      #t)))
+
+(define sob>?
+  (case-lambda
+    ((sob) #t)
+    ((sob1 sob2) (dyadic-sob>? sob1 sob2))
+    ((sob1 sob2 . sobs)
+     (and (dyadic-sob>? sob1 sob2)
+          (apply sob>? sob2 sobs)))))
+
+(define (set>? . sets)
+  (check-all-sets sets)
+  (apply sob>? sets))
+
+(define (bag>? . bags)
+  (check-all-bags bags)
+  (apply sob>? bags))
+
+;; > is the negation of <=.  Note that this is only true at the dyadic
+;; level; we can't just replace sob>? with a negation of sob<=?.
+
+(define (dyadic-sob>? sob1 sob2)
+  (not (dyadic-sob<=? sob1 sob2)))
+
+(define sob<?
+  (case-lambda
+    ((sob) #t)
+    ((sob1 sob2) (dyadic-sob<? sob1 sob2))
+    ((sob1 sob2 . sobs)
+     (and (dyadic-sob<? sob1 sob2)
+          (apply sob<? sob2 sobs)))))
+
+(define (set<? . sets)
+  (check-all-sets sets)
+  (apply sob<? sets))
+
+(define (bag<? . bags)
+  (check-all-bags bags)
+  (apply sob<? bags))
+
+;; < is the inverse of >.  Again, this is only true dyadically.
+
+(define (dyadic-sob<? sob1 sob2)
+  (dyadic-sob>? sob2 sob1))
+
+(define sob>=?
+  (case-lambda
+    ((sob) #t)
+    ((sob1 sob2) (dyadic-sob>=? sob1 sob2))
+    ((sob1 sob2 . sobs)
+     (and (dyadic-sob>=? sob1 sob2)
+          (apply sob>=? sob2 sobs)))))
+
+(define (set>=? . sets)
+  (check-all-sets sets)
+  (apply sob>=? sets))
+
+(define (bag>=? . bags)
+  (check-all-bags bags)
+  (apply sob>=? bags))
+
+;; Finally, >= is the negation of <.  Good thing we have tail recursion.
+
+(define (dyadic-sob>=? sob1 sob2)
+  (not (dyadic-sob<? sob1 sob2)))
+
+
+;;; Set theory operations
+
+;; A trivial helper function which upper-bounds n by one if multi? is false.
+
+(define (max-one n multi?)
+    (if multi? n (if (> n 1) 1 n)))
+
+;; The logic of union, intersection, difference, and sum is the same: the
+;; sob-* and sob-*! procedures do the reduction to the dyadic-sob-*!
+;; procedures.  The difference is that the sob-* procedures allocate
+;; an empty copy of the first sob to accumulate the results in, whereas
+;; the sob-*!  procedures work directly in the first sob.
+
+;; Note that there is no set-sum, as it is the same as set-union.
+
+(define (sob-union sob1 . sobs)
+  (if (null? sobs)
+    sob1
+    (let ((result (sob-empty-copy sob1)))
+      (dyadic-sob-union! result sob1 (car sobs))
+      (for-each
+       (lambda (sob) (dyadic-sob-union! result result sob))
+       (cdr sobs))
+      result)))
+
+;; For union, we take the max of the counts of each element found
+;; in either sob and put that in the result.  On the pass through
+;; sob2, we know that the intersection is already accounted for,
+;; so we just copy over things that aren't in sob1.
+
+(define (dyadic-sob-union! result sob1 sob2)
+  (let ((sob1-ht (sob-hash-table sob1))
+        (sob2-ht (sob-hash-table sob2))
+        (result-ht (sob-hash-table result)))
+    (hash-table-for-each
+      (lambda (key value1)
+        (let ((value2 (hash-table-ref/default sob2-ht key 0)))
+          (hash-table-set! result-ht key (max value1 value2))))
+      sob1-ht)
+    (hash-table-for-each
+      (lambda (key value2)
+        (let ((value1 (hash-table-ref/default sob1-ht key 0)))
+          (if (= value1 0)
+              (hash-table-set! result-ht key value2))))
+      sob2-ht)))
+
+(define (set-union . sets)
+  (check-all-sets sets)
+  (apply sob-union sets))
+
+(define (bag-union . bags)
+  (check-all-bags bags)
+  (apply sob-union bags))
+
+(define (sob-union! sob1 . sobs)
+  (for-each
+   (lambda (sob) (dyadic-sob-union! sob1 sob1 sob))
+   sobs)
+  sob1)
+
+(define (set-union! . sets)
+  (check-all-sets sets)
+  (apply sob-union! sets))
+
+(define (bag-union! . bags)
+  (check-all-bags bags)
+  (apply sob-union! bags))
+
+(define (sob-intersection sob1 . sobs)
+  (if (null? sobs)
+    sob1
+    (let ((result (sob-empty-copy sob1)))
+      (dyadic-sob-intersection! result sob1 (car sobs))
+      (for-each
+       (lambda (sob) (dyadic-sob-intersection! result result sob))
+       (cdr sobs))
+      (sob-cleanup! result))))
+
+;; For intersection, we compute the min of the counts of each element.
+;; We only have to scan sob1.  We clean up the result when we are
+;; done, in case it is the same as sob1.
+
+(define (dyadic-sob-intersection! result sob1 sob2)
+  (let ((sob1-ht (sob-hash-table sob1))
+        (sob2-ht (sob-hash-table sob2))
+        (result-ht (sob-hash-table result)))
+    (hash-table-for-each
+      (lambda (key value1)
+        (let ((value2 (hash-table-ref/default sob2-ht key 0)))
+          (hash-table-set! result-ht key (min value1 value2))))
+      sob1-ht)))
+
+(define (set-intersection . sets)
+  (check-all-sets sets)
+  (apply sob-intersection sets))
+
+(define (bag-intersection . bags)
+  (check-all-bags bags)
+  (apply sob-intersection bags))
+
+(define (sob-intersection! sob1 . sobs)
+  (for-each
+   (lambda (sob) (dyadic-sob-intersection! sob1 sob1 sob))
+   sobs)
+  (sob-cleanup! sob1))
+
+(define (set-intersection! . sets)
+  (check-all-sets sets)
+  (apply sob-intersection! sets))
+
+(define (bag-intersection! . bags)
+  (check-all-bags bags)
+  (apply sob-intersection! bags))
+
+(define (sob-difference sob1 . sobs)
+  (if (null? sobs)
+    sob1
+    (let ((result (sob-empty-copy sob1)))
+      (dyadic-sob-difference! result sob1 (car sobs))
+      (for-each
+       (lambda (sob) (dyadic-sob-difference! result result sob))
+       (cdr sobs))
+      (sob-cleanup! result))))
+
+;; For difference, we use (big surprise) the numeric difference, bounded
+;; by zero.  We only need to scan sob1, but we clean up the result in
+;; case it is the same as sob1.
+
+(define (dyadic-sob-difference! result sob1 sob2)
+  (let ((sob1-ht (sob-hash-table sob1))
+        (sob2-ht (sob-hash-table sob2))
+        (result-ht (sob-hash-table result)))
+    (hash-table-for-each
+      (lambda (key value1)
+        (let ((value2 (hash-table-ref/default sob2-ht key 0)))
+          (hash-table-set! result-ht key (- value1 value2))))
+      sob1-ht)))
+
+(define (set-difference . sets)
+  (check-all-sets sets)
+  (apply sob-difference sets))
+
+(define (bag-difference . bags)
+  (check-all-bags bags)
+  (apply sob-difference bags))
+
+(define (sob-difference! sob1 . sobs)
+  (for-each
+   (lambda (sob) (dyadic-sob-difference! sob1 sob1 sob))
+   sobs)
+  (sob-cleanup! sob1))
+
+(define (set-difference! . sets)
+  (check-all-sets sets)
+  (apply sob-difference! sets))
+
+(define (bag-difference! . bags)
+  (check-all-bags bags)
+  (apply sob-difference! bags))
+
+(define (sob-sum sob1 . sobs)
+  (if (null? sobs)
+    sob1
+    (let ((result (sob-empty-copy sob1)))
+      (dyadic-sob-sum! result sob1 (car sobs))
+      (for-each
+       (lambda (sob) (dyadic-sob-sum! result result sob))
+       (cdr sobs))
+      result)))
+
+;; Sum is just like union, except that we take the sum rather than the max.
+
+(define (dyadic-sob-sum! result sob1 sob2)
+  (let ((sob1-ht (sob-hash-table sob1))
+        (sob2-ht (sob-hash-table sob2))
+        (result-ht (sob-hash-table result)))
+    (hash-table-for-each
+      (lambda (key value1)
+        (let ((value2 (hash-table-ref/default sob2-ht key 0)))
+          (hash-table-set! result-ht key (+ value1 value2))))
+      sob1-ht)
+    (hash-table-for-each
+      (lambda (key value2)
+        (let ((value1 (hash-table-ref/default sob1-ht key 0)))
+          (if (= value1 0)
+              (hash-table-set! result-ht key value2))))
+      sob2-ht)))
+
+
+;; Sum is defined for bags only; for sets, it is the same as union.
+
+(define (bag-sum . bags)
+  (check-all-bags bags)
+  (apply sob-sum bags))
+
+(define (sob-sum! sob1 . sobs)
+  (for-each
+   (lambda (sob) (dyadic-sob-sum! sob1 sob1 sob))
+   sobs)
+  sob1)
+
+(define (bag-sum! . bags)
+  (check-all-bags bags)
+  (apply sob-sum! bags))
+
+;; For xor exactly two arguments are required, so the above structures are
+;; not necessary.  This version accepts a result sob and computes the
+;; absolute difference between the counts in the first sob and the
+;; corresponding counts in the second.
+
+;; We start by copying the entries in the second sob but not the first
+;; into the first.  Then we scan the first sob, computing the absolute
+;; difference of the values and writing them back into the first sob.
+;; It's essential to scan the second sob first, as we are not going to
+;; damage it in the process.  (Hat tip: Sam Tobin-Hochstadt.)
+
+(define (sob-xor! result sob1 sob2)
+  (let ((sob1-ht (sob-hash-table sob1))
+        (sob2-ht (sob-hash-table sob2))
+        (result-ht (sob-hash-table result)))
+    (hash-table-for-each
+      (lambda (key value2)
+        (let ((value1 (hash-table-ref/default sob1-ht key 0)))
+          (if (= value1 0)
+              (hash-table-set! result-ht key value2))))
+      sob2-ht)
+    (hash-table-for-each
+      (lambda (key value1)
+        (let ((value2 (hash-table-ref/default sob2-ht key 0)))
+          (hash-table-set! result-ht key (abs (- value1 value2)))))
+      sob1-ht)
+    (sob-cleanup! result)))
+
+(define (set-xor set1 set2)
+  (check-set set1)
+  (check-set set2)
+  (check-same-comparator set1 set2)
+  (sob-xor! (sob-empty-copy set1) set1 set2))
+
+(define (bag-xor bag1 bag2)
+  (check-bag bag1)
+  (check-bag bag2)
+  (check-same-comparator bag1 bag2)
+  (sob-xor! (sob-empty-copy bag1) bag1 bag2))
+
+(define (set-xor! set1 set2)
+  (check-set set1)
+  (check-set set2)
+  (check-same-comparator set1 set2)
+  (sob-xor! set1 set1 set2))
+
+(define (bag-xor! bag1 bag2)
+  (check-bag bag1)
+  (check-bag bag2)
+  (check-same-comparator bag1 bag2)
+  (sob-xor! bag1 bag1 bag2))
+
+
+;;; A few bag-specific procedures
+
+(define (sob-product! n result sob)
+  (let ((rht (sob-hash-table result)))
+    (hash-table-for-each
+      (lambda (elem count) (hash-table-set! rht elem (* count n)))
+      (sob-hash-table sob))
+    result))
+
+(define (valid-n n)
+   (and (integer? n) (exact? n) (positive? n)))
+
+(define (bag-product n bag)
+  (check-bag bag)
+  (valid-n n)
+  (sob-product! n (sob-empty-copy bag) bag))
+
+(define (bag-product! n bag)
+  (check-bag bag)
+  (valid-n n)
+  (sob-product! n bag bag))
+
+(define (bag-unique-size bag)
+  (check-bag bag)
+  (hash-table-size (sob-hash-table bag)))
+
+(define (bag-element-count bag elem)
+  (check-bag bag)
+  (hash-table-ref/default (sob-hash-table bag) elem 0))
+
+(define (bag-for-each-unique proc bag)
+  (check-bag bag)
+  (hash-table-for-each
+    (lambda (key value) (proc key value))
+    (sob-hash-table bag)))
+
+(define (bag-fold-unique proc nil bag)
+  (check-bag bag)
+  (let ((result nil))
+    (hash-table-for-each
+      (lambda (elem count) (set! result (proc elem count result)))
+      (sob-hash-table bag))
+    result))
+
+(define (bag->set bag)
+  (check-bag bag)
+  (let ((result (make-sob (sob-comparator bag) #f)))
+    (hash-table-for-each
+      (lambda (key value) (sob-increment! result key value))
+      (sob-hash-table bag))
+    result))
+
+(define (set->bag set)
+  (check-set set)
+  (let ((result (make-sob (sob-comparator set) #t)))
+    (hash-table-for-each
+      (lambda (key value) (sob-increment! result key value))
+      (sob-hash-table set))
+    result))
+
+(define (set->bag! bag set)
+  (check-bag bag)
+  (check-set set)
+  (check-same-comparator set bag)
+  (hash-table-for-each
+    (lambda (key value) (sob-increment! bag key value))
+    (sob-hash-table set))
+  bag)
+
+(define (bag->alist bag)
+  (check-bag bag)
+  (bag-fold-unique
+    (lambda (elem count list) (cons (cons elem count) list))
+    '()
+    bag))
+
+(define (alist->bag comparator alist)
+  (let* ((result (bag comparator))
+         (ht (sob-hash-table result)))
+    (for-each
+      (lambda (assoc)
+        (let ((element (car assoc)))
+          (if (not (hash-table-contains? ht element))
+              (sob-increment! result element (cdr assoc)))))
+      alist)
+    result))
+
+;;; Comparators
+
+;; Hash over sobs
+(define (sob-hash sob)
+  (let* ((ht (sob-hash-table sob))
+         (hash (comparator-hash-function (sob-comparator sob))))
+    (sob-fold
+      (lambda (element result) (+ (hash element) result))
+      5381
+      sob)))
+
+;; Set and bag comparator
+
+(define set-comparator (make-comparator set? set=? #f sob-hash))
+
+(define bag-comparator (make-comparator bag? bag=? #f sob-hash))
+
+;;; Register above comparators for use by default-comparator
+(comparator-register-default! set-comparator)
+(comparator-register-default! bag-comparator)
+
+;;; Set/bag printer (for debugging)
+
+(define (sob-print sob port)
+  (display (if (sob-multi? sob) "&bag[" "&set[") port)
+  (sob-for-each
+    (lambda (elem) (display " " port) (write elem port))
+    sob)
+  (display " ]" port))
+
+;; Chicken-specific
+(cond-expand
+  (chicken
+    (define-record-printer sob sob-print))
+  (else))
diff --git a/srfi/sets/sets-test.scm b/srfi/sets/sets-test.scm
new file mode 100644
index 00000000..9a2460b6
--- /dev/null
+++ b/srfi/sets/sets-test.scm
@@ -0,0 +1,627 @@
+(import 
+  (scheme base) 
+  (scheme char)
+  (scheme complex)
+  (scheme cyclone test)
+  (sets)
+  (srfi 128)
+)
+(include "comparators-shim.scm")
+;(use test)
+;(use srfi-113)
+;(use srfi-128)
+;(load "../sets/comparators-shim.scm")
+
+(test-group "sets"
+(define (big x) (> x 5))
+
+(test-group "sets"
+(test-group "sets/simple"
+  (define nums (set number-comparator))
+  ;; nums is now {}
+  (define syms (set eq-comparator 'a 'b 'c 'd))
+  ;; syms is now {a, b, c, d}
+  (define nums2 (set-copy nums))
+  ;; nums2 is now {}
+  (define syms2 (set-copy syms))
+  ;; syms2 is now {a, b, c, d}
+  (define esyms (set eq-comparator))
+  ;; esyms is now {}
+  (test-assert (set-empty? esyms))
+  (define total 0)
+  (test-assert (set? nums))
+  (test-assert (set? syms))
+  (test-assert (set? nums2))
+  (test-assert (set? syms2))
+  (test-assert (not (set? 'a)))
+  (set-adjoin! nums 2)
+  (set-adjoin! nums 3)
+  (set-adjoin! nums 4)
+  (set-adjoin! nums 4)
+  ;; nums is now {2, 3, 4}
+  (test 4 (set-size (set-adjoin nums 5)))
+  (test 3 (set-size nums))
+  (test 3 (set-size (set-delete syms 'd)))
+  (test 2 (set-size (set-delete-all syms '(c d))))
+  (test 4 (set-size syms))
+  (set-adjoin! syms 'e 'f)
+  ;; syms is now {a, b, c, d, e, f}
+  (test 4 (set-size (set-delete-all! syms '(e f))))
+  ;; syms is now {a, b, c, d}
+  (test 0 (set-size nums2))
+  (test 4 (set-size syms2))
+  (set-delete! nums 2)
+  ;; nums is now {3, 4}
+  (test 2 (set-size nums))
+  (set-delete! nums 1)
+  (test 2 (set-size nums))
+  ; Broken! - (set! nums2 (set-map (lambda (x) (* 10 x)) number-comparator nums))
+  (set! nums2 (set-map number-comparator (lambda (x) (* 10 x)) nums))
+  ;; nums2 is now {30, 40}
+  (test-assert (set-contains? nums2 30))
+  (test-assert (not (set-contains? nums2 3)))
+  (set-for-each (lambda (x) (set! total (+ total x))) nums2)
+  (test 70 total)
+  (test 10 (set-fold + 3 nums))
+  (set! nums (set eqv-comparator 10 20 30 40 50))
+  ;; nums is now {10, 20, 30, 40, 50}
+  (test-assert
+    (set=? nums (set-unfold
+       (lambda (i) (= i 0))
+       (lambda (i) (* i 10))
+       (lambda (i) (- i 1))
+       5
+       eqv-comparator)))
+  (test '(a) (set->list (set eq-comparator 'a)))
+  (set! syms2 (list->set eq-comparator '(e f)))
+  ;; syms2 is now {e, f}
+  (test 2 (set-size syms2))
+  (test-assert (set-contains? syms2 'e))
+  (test-assert (set-contains? syms2 'f))
+  (list->set! syms2 '(a b))
+  (test 4 (set-size syms2))
+) ; end sets/simple
+
+(test-group "sets/search"
+  (define yam (set char-comparator #\y #\a #\m))
+  (define (failure/insert insert ignore)
+    (insert 1))
+  (define (failure/ignore insert ignore)
+    (ignore 2))
+  (define (success/update element update remove)
+    (update #\b 3))
+  (define (success/remove element update remove)
+    (remove 4))
+  (define yam! (set char-comparator #\y #\a #\m #\!))
+  (define bam (set char-comparator #\b #\a #\m))
+  (define ym (set char-comparator #\y #\m))
+;  (define-values (set1 obj1)
+;    (set-search! (set-copy yam) #\! failure/insert error))
+;  (test-assert (set=? yam! set1))
+;  (test 1 obj1)
+;  (define-values (set2 obj2)
+;    (set-search! (set-copy yam) #\! failure/ignore error))
+;  (test-assert (set=? yam set2))
+;  (test 2 obj2)
+;  (define-values (set3 obj3)
+;    (set-search! (set-copy yam) #\y error success/update))
+;  (test-assert (set=? bam set3))
+;  (test 3 obj3)
+;  (define-values (set4 obj4)
+;    (set-search! (set-copy yam) #\a error success/remove))
+;  (test-assert (set=? ym set4))
+;  (test 4 obj4)
+) ; end sets/search
+
+(test-group "sets/subsets"
+  (define set2 (set number-comparator 1 2))
+  (define other-set2 (set number-comparator 1 2))
+  (define set3 (set number-comparator 1 2 3))
+  (define set4 (set number-comparator 1 2 3 4))
+  (define setx (set number-comparator 10 20 30 40))
+  (test-assert (set=? set2 other-set2))
+  (test-assert (not (set=? set2 set3)))
+  (test-assert (not (set=? set2 set3 other-set2)))
+  (test-assert (set<? set2 set3 set4))
+  (test-assert (not (set<? set2 other-set2)))
+  (test-assert (set<=? set2 other-set2 set3))
+  (test-assert (not (set<=? set2 set3 other-set2)))
+  (test-assert (set>? set4 set3 set2))
+  (test-assert (not (set>? set2 other-set2)))
+  (test-assert (set>=? set3 other-set2 set2))
+  (test-assert (not (set>=? other-set2 set3 set2)))
+) ; end sets/subsets
+
+(test-group "sets/ops"
+  ;; Potentially mutable
+  (define abcd (set eq-comparator 'a 'b 'c 'd))
+  (define efgh (set eq-comparator 'e 'f 'g 'h))
+  (define abgh (set eq-comparator 'a 'b 'g 'h))
+  ;; Never get a chance to be mutated
+  (define other-abcd (set eq-comparator 'a 'b 'c 'd))
+  (define other-efgh (set eq-comparator 'e 'f 'g 'h))
+  (define other-abgh (set eq-comparator 'a 'b 'g 'h))
+  (define all (set eq-comparator 'a 'b 'c 'd 'e 'f 'g 'h))
+  (define none (set eq-comparator))
+  (define ab (set eq-comparator 'a 'b))
+  (define cd (set eq-comparator 'c 'd))
+  (define ef (set eq-comparator 'e 'f))
+  (define gh (set eq-comparator 'g 'h))
+  (define cdgh (set eq-comparator 'c 'd 'g 'h))
+  (define abcdgh (set eq-comparator 'a 'b 'c 'd 'g 'h))
+  (define abefgh (set eq-comparator 'a 'b 'e 'f 'g 'h))
+  (test-assert (set-disjoint? abcd efgh))
+  (test-assert (not (set-disjoint? abcd ab)))
+  (parameterize ((current-test-comparator set=?))
+    (test abcd (set-union abcd))
+    (test all (set-union abcd efgh))
+    (test abcdgh (set-union abcd abgh))
+    (test abefgh (set-union efgh abgh))
+    (define efgh2 (set-copy efgh))
+    (set-union! efgh2)
+    (test efgh efgh2)
+    (set-union! efgh2 abgh)
+    (test abefgh efgh2)
+    (test abcd (set-intersection abcd))
+    (test none (set-intersection abcd efgh))
+    (define abcd2 (set-copy abcd))
+    (set-intersection! abcd2)
+    (test abcd abcd2)
+    (set-intersection! abcd2 efgh)
+    (test none abcd2)
+    (test ab (set-intersection abcd abgh))
+    (test ab (set-intersection abgh abcd))
+    (test abcd (set-difference abcd))
+    (test cd (set-difference abcd ab))
+    (test abcd (set-difference abcd gh))
+    (test none (set-difference abcd abcd))
+    (define abcd3 (set-copy abcd))
+    (set-difference! abcd3)
+    (test abcd abcd3)
+    (set-difference! abcd3 abcd)
+    (test none abcd3)
+    (test cdgh (set-xor abcd abgh))
+    (test all (set-xor abcd efgh))
+    (test none (set-xor abcd other-abcd))
+    (define abcd4 (set-copy abcd))
+    ;; don't test xor! effect
+    (test none (set-xor! abcd4 other-abcd))
+    (test "abcd smashed?" other-abcd abcd)
+    (test "efgh smashed?" other-efgh efgh)
+    (test "abgh smashed?" other-abgh abgh))
+) ; end sets/subsets
+
+(test-group "sets/mismatch"
+  (define nums (set number-comparator 1 2 3))
+  (define syms (set eq-comparator 'a 'b 'c))
+  (test-error (set=? nums syms))
+  (test-error (set<? nums syms))
+  (test-error (set<=? nums syms))
+  (test-error (set>? nums syms))
+  (test-error (set>=? nums syms))
+  (test-error (set-union nums syms))
+  (test-error (set-intersection nums syms))
+  (test-error (set-difference nums syms))
+  (test-error (set-xor nums syms))
+  (test-error (set-union! nums syms))
+  (test-error (set-intersection! nums syms))
+  (test-error (set-difference! nums syms))
+  (test-error (set-xor! nums syms))
+) ; end sets/mismatch
+
+(test-group "sets/whole"
+  (define whole (set eqv-comparator 1 2 3 4 5 6 7 8 9 10))
+  (define whole2 (set-copy whole))
+  (define whole3 (set-copy whole))
+  (define whole4 (set-copy whole))
+  (define bottom (set eqv-comparator 1 2 3 4 5))
+  (define top (set eqv-comparator 6 7 8 9 10))
+;  (define-values (topx bottomx)
+;    (set-partition big whole))
+;  (set-partition! big whole4)
+;  (parameterize ((current-test-comparator set=?))
+;    (test top (set-filter big whole))
+;    (test bottom (set-remove big whole))
+;    (set-filter! big whole2)
+;    (test-assert (not (set-contains? whole2 1)))
+;    (set-remove! big whole3)
+;    (test-assert (not (set-contains? whole3 10)))
+;    (test top topx)
+;    (test bottom bottomx)
+;    (test top whole4))
+  (test 5 (set-count big whole))
+  (define hetero (set eqv-comparator 1 2 'a 3 4))
+  (define homo (set eqv-comparator 1 2 3 4 5))
+  (test 'a (set-find symbol? hetero (lambda () (error "wrong"))))
+  (test-error  (set-find symbol? homo (lambda () (error "wrong"))))
+  (test-assert (set-any? symbol? hetero))
+  (test-assert (set-any? number? hetero))
+  (test-assert (not (set-every? symbol? hetero)))
+  (test-assert (not (set-every? number? hetero)))
+  (test-assert (not (set-any? symbol? homo)))
+  (test-assert (set-every? number? homo))
+) ; end sets/whole
+
+(test-group "sets/lowlevel"
+  (define bucket (set string-ci-comparator "abc" "def"))
+  (test string-ci-comparator (set-element-comparator bucket))
+  (test-assert (set-contains? bucket "abc"))
+  (test-assert (set-contains? bucket "ABC"))
+  (test "def" (set-member bucket "DEF" "fqz"))
+  (test "fqz" (set-member bucket "lmn" "fqz"))
+  (define nums (set number-comparator 1 2 3))
+  ;; nums is now {1, 2, 3}
+  (define nums2 (set-replace nums 2.0))
+  ;; nums2 is now {1, 2.0, 3}
+  (test-assert (set-any? inexact? nums2))
+  (set-replace! nums 2.0)
+  ;; nums is now {1, 2.0, 3}
+  (test-assert (set-any? inexact? nums))
+  (define sos
+    (set set-comparator
+      (set equal-comparator '(2 . 1) '(1 . 1) '(0 . 2) '(0 . 0))
+      (set equal-comparator '(2 . 1) '(1 . 1) '(0 . 0) '(0 . 2))))
+  (test 1 (set-size sos))
+) ; end sets/lowlevel
+
+) ; end sets
+
+(test-group "bags"
+(test-group "bags/simple"
+  (define nums (bag number-comparator))
+  ;; nums is now {}
+  (define syms (bag eq-comparator 'a 'b 'c 'd))
+  ;; syms is now {a, b, c, d}
+  (define nums2 (bag-copy nums))
+  ;; nums2 is now {}
+  (define syms2 (bag-copy syms))
+  ;; syms2 is now {a, b, c, d}
+  (define esyms (bag eq-comparator))
+  ;; esyms is now {}
+  (test-assert (bag-empty? esyms))
+  (define total 0)
+  (test-assert (bag? nums))
+  (test-assert (bag? syms))
+  (test-assert (bag? nums2))
+  (test-assert (bag? syms2))
+  (test-assert (not (bag? 'a)))
+  (bag-adjoin! nums 2)
+  (bag-adjoin! nums 3)
+  (bag-adjoin! nums 4)
+  ;; nums is now {2, 3, 4}
+  (test 4 (bag-size (bag-adjoin nums 5)))
+  (test 3 (bag-size nums))
+  (test 3 (bag-size (bag-delete syms 'd)))
+  (test 2 (bag-size (bag-delete-all syms '(c d))))
+  (test 4 (bag-size syms))
+  (bag-adjoin! syms 'e 'f)
+  ;; syms is now {a, b, c, d, e, f}
+  (test 4 (bag-size (bag-delete-all! syms '(e f))))
+  ;; syms is now {a, b, c, d}
+  (test 3 (bag-size nums))
+  (bag-delete! nums 1)
+  (test 3 (bag-size nums))
+  ; Broken - (set! nums2 (bag-map (lambda (x) (* 10 x)) number-comparator nums))
+  (set! nums2 (bag-map number-comparator (lambda (x) (* 10 x)) nums))
+  ;; nums2 is now {20, 30, 40}
+  (test-assert (bag-contains? nums2 30))
+  (test-assert (not (bag-contains? nums2 3)))
+  (bag-for-each (lambda (x) (set! total (+ total x))) nums2)
+  (test 90 total)
+  (test 12 (bag-fold + 3 nums))
+  (set! nums (bag eqv-comparator 10 20 30 40 50))
+  ;; nums is now {10, 20, 30, 40, 50}
+  (test-assert
+    (bag=? nums (bag-unfold
+       (lambda (i) (= i 0))
+       (lambda (i) (* i 10))
+       (lambda (i) (- i 1))
+       5
+       eqv-comparator)))
+  (test '(a) (bag->list (bag eq-comparator 'a)))
+  (set! syms2 (list->bag eq-comparator '(e f)))
+  ;; syms2 is now {e, f}
+  (test 2 (bag-size syms2))
+  (test-assert (bag-contains? syms2 'e))
+  (test-assert (bag-contains? syms2 'f))
+  (list->bag! syms2 '(e f))
+  ;; syms2 is now {e, e, f, f}
+  (test 4 (bag-size syms2))
+) ; end bags/simple
+
+(test-group "bags/search"
+  (define yam (bag char-comparator #\y #\a #\m))
+  (define (failure/insert insert ignore)
+    (insert 1))
+  (define (failure/ignore insert ignore)
+    (ignore 2))
+  (define (success/update element update remove)
+    (update #\b 3))
+  (define (success/remove element update remove)
+    (remove 4))
+  (define yam! (bag char-comparator #\y #\a #\m #\!))
+  (define bam (bag char-comparator #\b #\a #\m))
+  (define ym (bag char-comparator #\y #\m))
+;  (define-values (bag1 obj1)
+;    (bag-search! (bag-copy yam) #\! failure/insert error))
+;  (test-assert (bag=? yam! bag1))
+;  (test 1 obj1)
+;  (define-values (bag2 obj2)
+;    (bag-search! (bag-copy yam) #\! failure/ignore error))
+;  (test-assert (bag=? yam bag2))
+;  (test 2 obj2)
+;  (define-values (bag3 obj3)
+;    (bag-search! (bag-copy yam) #\y error success/update))
+;  (test-assert (bag=? bam bag3))
+;  (test 3 obj3)
+;  (define-values (bag4 obj4)
+;    (bag-search! (bag-copy yam) #\a error success/remove))
+;  (test-assert (bag=? ym bag4))
+;  (test 4 obj4)
+) ; end bags/search
+
+(test-group "bags/elemcount"
+  (define mybag (bag eqv-comparator 1 1 1 1 1 2 2))
+  (test 5 (bag-element-count mybag 1))
+  (test 0 (bag-element-count mybag 3))
+) ; end bags/elemcount
+
+(test-group "bags/subbags"
+  (define bag2 (bag number-comparator 1 2))
+  (define other-bag2 (bag number-comparator 1 2))
+  (define bag3 (bag number-comparator 1 2 3))
+  (define bag4 (bag number-comparator 1 2 3 4))
+  (define bagx (bag number-comparator 10 20 30 40))
+  (test-assert (bag=? bag2 other-bag2))
+  (test-assert (not (bag=? bag2 bag3)))
+  (test-assert (not (bag=? bag2 bag3 other-bag2)))
+  (test-assert (bag<? bag2 bag3 bag4))
+  (test-assert (not (bag<? bag2 other-bag2)))
+  (test-assert (bag<=? bag2 other-bag2 bag3))
+  (test-assert (not (bag<=? bag2 bag3 other-bag2)))
+  (test-assert (bag>? bag4 bag3 bag2))
+  (test-assert (not (bag>? bag2 other-bag2)))
+  (test-assert (bag>=? bag3 other-bag2 bag2))
+  (test-assert (not (bag>=? other-bag2 bag3 bag2)))
+) ; end bags/subbags
+
+(test-group "bags/multi"
+  (define one (bag eqv-comparator 10))
+  (define two (bag eqv-comparator 10 10))
+  (test-assert (not (bag=? one two)))
+  (test-assert (bag<? one two))
+  (test-assert (not (bag>? one two)))
+  (test-assert (bag<=? one two))
+  (test-assert (not (bag>? one two)))
+  (test-assert (bag=? two two))
+  (test-assert (not (bag<? two two)))
+  (test-assert (not (bag>? two two)))
+  (test-assert (bag<=? two two))
+  (test-assert (bag>=? two two))
+  (test '((10 . 2))
+    (let ((result '()))
+      (bag-for-each-unique
+         (lambda (x y) (set! result (cons (cons x y) result)))
+         two)
+      result))
+  (test 25 (bag-fold + 5 two))
+  (test 12 (bag-fold-unique (lambda (k n r) (+ k n r)) 0 two))
+) ; end bags/multi
+
+(test-group "bags/ops"
+  ;; Potentially mutable
+  (define abcd (bag eq-comparator 'a 'b 'c 'd))
+  (define efgh (bag eq-comparator 'e 'f 'g 'h))
+  (define abgh (bag eq-comparator 'a 'b 'g 'h))
+  ;; Never get a chance to be mutated
+  (define other-abcd (bag eq-comparator 'a 'b 'c 'd))
+  (define other-efgh (bag eq-comparator 'e 'f 'g 'h))
+  (define other-abgh (bag eq-comparator 'a 'b 'g 'h))
+  (define all (bag eq-comparator 'a 'b 'c 'd 'e 'f 'g 'h))
+  (define none (bag eq-comparator))
+  (define ab (bag eq-comparator 'a 'b))
+  (define cd (bag eq-comparator 'c 'd))
+  (define ef (bag eq-comparator 'e 'f))
+  (define gh (bag eq-comparator 'g 'h))
+  (define cdgh (bag eq-comparator 'c 'd 'g 'h))
+  (define abcdgh (bag eq-comparator 'a 'b 'c 'd 'g 'h))
+  (define abefgh (bag eq-comparator 'a 'b 'e 'f 'g 'h))
+  (test-assert (bag-disjoint? abcd efgh))
+  (test-assert (not (bag-disjoint? abcd ab)))
+  (parameterize ((current-test-comparator bag=?))
+    (test abcd (bag-union abcd))
+    (test all (bag-union abcd efgh))
+    (test abcdgh (bag-union abcd abgh))
+    (test abefgh (bag-union efgh abgh))
+    (define efgh2 (bag-copy efgh))
+    (bag-union! efgh2)
+    (test efgh efgh2)
+    (bag-union! efgh2 abgh)
+    (test abefgh efgh2)
+    (test abcd (bag-intersection abcd))
+    (test none (bag-intersection abcd efgh))
+    (define abcd2 (bag-copy abcd))
+    (bag-intersection! abcd2)
+    (test abcd abcd2)
+    (bag-intersection! abcd2 efgh)
+    (test none abcd2)
+    (test ab (bag-intersection abcd abgh))
+    (test ab (bag-intersection abgh abcd))
+    (test abcd (bag-difference abcd))
+    (test cd (bag-difference abcd ab))
+    (test abcd (bag-difference abcd gh))
+    (test none (bag-difference abcd abcd))
+    (define abcd3 (bag-copy abcd))
+    (bag-difference! abcd3)
+    (test abcd abcd3)
+    (bag-difference! abcd3 abcd)
+    (test none abcd3)
+    (test cdgh (bag-xor abcd abgh))
+    (test all (bag-xor abcd efgh))
+    (test none (bag-xor abcd other-abcd))
+    (define abcd4 (bag-copy abcd))
+    (test none (bag-xor! abcd4 other-abcd))
+    (define abab (bag eq-comparator 'a 'b 'a 'b))
+    (test ab (bag-sum ab))
+    (define ab2 (bag-copy ab))
+    (test ab (bag-sum! ab2))
+    (test abab (bag-sum! ab2 ab))
+    (test abab ab2)
+    (test abab (bag-product 2 ab))
+    (define ab3 (bag-copy ab))
+    (bag-product! 2 ab3)
+    (test abab ab3)
+    (test "abcd smashed?" other-abcd abcd)
+    (test "abcd smashed?" other-abcd abcd)
+    (test "efgh smashed?" other-efgh efgh)
+    (test "abgh smashed?" other-abgh abgh))
+) ; end bags/ops
+
+(test-group "bags/mismatch"
+  (define nums (bag number-comparator 1 2 3))
+  (define syms (bag eq-comparator 'a 'b 'c))
+  (test-error (bag=? nums syms))
+  (test-error (bag<? nums syms))
+  (test-error (bag<=? nums syms))
+  (test-error (bag>? nums syms))
+  (test-error (bag>=? nums syms))
+  (test-error (bag-union nums syms))
+  (test-error (bag-intersection nums syms))
+  (test-error (bag-difference nums syms))
+  (test-error (bag-xor nums syms))
+  (test-error (bag-union! nums syms))
+  (test-error (bag-intersection! nums syms))
+  (test-error (bag-difference! nums syms))
+) ; end bags/mismatch
+
+(test-group "bags/whole"
+  (define whole (bag eqv-comparator 1 2 3 4 5 6 7 8 9 10))
+  (define whole2 (bag-copy whole))
+  (define whole3 (bag-copy whole))
+  (define whole4 (bag-copy whole))
+  (define bottom (bag eqv-comparator 1 2 3 4 5))
+  (define top (bag eqv-comparator 6 7 8 9 10))
+;  (define-values (topx bottomx)
+;    (bag-partition big whole))
+;  (bag-partition! big whole4)
+;  (parameterize ((current-test-comparator bag=?))
+;    (test top (bag-filter big whole))
+;    (test bottom (bag-remove big whole))
+;    (bag-filter! big whole2)
+;    (test-assert (not (bag-contains? whole2 1)))
+;    (bag-remove! big whole3)
+;    (test-assert (not (bag-contains? whole3 10)))
+;    (test top topx)
+;    (test bottom bottomx)
+;    (test top whole4))
+  (test 5 (bag-count big whole))
+  (define hetero (bag eqv-comparator 1 2 'a 3 4))
+  (define homo (bag eqv-comparator 1 2 3 4 5))
+  (test 'a (bag-find symbol? hetero (lambda () (error "wrong"))))
+  (test-error  (bag-find symbol? homo (lambda () (error "wrong"))))
+  (test-assert (bag-any? symbol? hetero))
+  (test-assert (bag-any? number? hetero))
+  (test-assert (not (bag-every? symbol? hetero)))
+  (test-assert (not (bag-every? number? hetero)))
+  (test-assert (not (bag-any? symbol? homo)))
+  (test-assert (bag-every? number? homo))
+) ; end bags/whole
+
+(test-group "bags/lowlevel"
+  (define bucket (bag string-ci-comparator "abc" "def"))
+  (test string-ci-comparator (bag-element-comparator bucket))
+  (test-assert (bag-contains? bucket "abc"))
+  (test-assert (bag-contains? bucket "ABC"))
+  (test "def" (bag-member bucket "DEF" "fqz"))
+  (test "fqz" (bag-member bucket "lmn" "fqz"))
+  (define nums (bag number-comparator 1 2 3))
+  ;; nums is now {1, 2, 3}
+  (define nums2 (bag-replace nums 2.0))
+  ;; nums2 is now {1, 2.0, 3}
+  (test-assert (bag-any? inexact? nums2))
+  (bag-replace! nums 2.0)
+  ;; nums is now {1, 2.0, 3}
+  (test-assert (bag-any? inexact? nums))
+  (define bob
+    (bag bag-comparator
+      (bag eqv-comparator 1 2)
+      (bag eqv-comparator 1 2)))
+  (test 2 (bag-size bob))
+) ; end bags/lowlevel
+
+
+(test-group "bags/semantics"
+  (define mybag (bag number-comparator 1 2))
+  ;; mybag is {1, 2}
+  (test 2 (bag-size mybag))
+  (bag-adjoin! mybag 1)
+  ;; mybag is {1, 1, 2}
+  (test 3 (bag-size mybag))
+  (test 2 (bag-unique-size mybag))
+  (bag-delete! mybag 2)
+  ;; mybag is {1, 1}
+  (bag-delete! mybag 2)
+  (test 2 (bag-size mybag))
+  (bag-increment! mybag 1 3)
+  ;; mybag is {1, 1, 1, 1, 1}
+  (test 5 (bag-size mybag))
+  (test-assert (bag-decrement! mybag 1 2))
+  ;; mybag is {1, 1, 1}
+  (test 3 (bag-size mybag))
+  (bag-decrement! mybag 1 5)
+  ;; mybag is {}
+  (test 0 (bag-size mybag))
+) ; end bags/semantics
+
+(test-group "bags/convert"
+  (define multi (bag eqv-comparator 1 2 2 3 3 3))
+  (define single (bag eqv-comparator 1 2 3))
+  (define singleset (set eqv-comparator 1 2 3))
+  (define minibag (bag eqv-comparator 'a 'a))
+  (define alist '((a . 2)))
+  (test alist (bag->alist minibag))
+  (test-assert (bag=? minibag (alist->bag eqv-comparator alist)))
+  (test-assert (set=? singleset (bag->set single)))
+  (test-assert (set=? singleset (bag->set multi)))
+  (test-assert (bag=? single (set->bag singleset)))
+  (test-assert (not (bag=? multi (set->bag singleset))))
+  (set->bag! minibag singleset)
+  ;; minibag is now {a, a, a, a, 1, 2, 3}
+  (test-assert (bag-contains? minibag 1))
+) ; end bags/convert
+
+(test-group "bags/sumprod"
+  (define abb (bag eq-comparator 'a 'b 'b))
+  (define aab (bag eq-comparator 'a 'a 'b))
+  (define total (bag-sum abb aab))
+  (test 3 (bag-count (lambda (x) (eqv? x 'a)) total))
+  (test 3 (bag-count (lambda (x) (eqv? x 'b)) total))
+  (test 12 (bag-size (bag-product 2 total)))
+  (define bag1 (bag eqv-comparator 1))
+  (bag-sum! bag1 bag1)
+  (test 2 (bag-size bag1))
+  (bag-product! 2 bag1)
+  (test 4 (bag-size bag1))
+) ; end bag/sumprod
+
+) ; end bags
+
+
+
+(test-group "comparators"
+  (define a (set number-comparator 1 2 3))
+  (define b (set number-comparator 1 2 4))
+  (define aa (bag number-comparator 1 2 3))
+  (define bb (bag number-comparator 1 2 4))
+  (test-assert (not (=? set-comparator a b)))
+  (test-assert (=? set-comparator a (set-copy a)))
+  (test-error (<? set-comparator a b))
+  (test-assert (not (=? bag-comparator aa bb)))
+  (test-assert (=? bag-comparator aa (bag-copy aa)))
+  (test-error (<? bag-comparator aa bb))
+  (test-assert (not (=? (make-default-comparator) a aa)))
+) ; end comparators
+
+) ; end r7rs-sets
+
+(test-exit)
diff --git a/srfi/sets/sets.sld b/srfi/sets/sets.sld
new file mode 100644
index 00000000..1d47e1dc
--- /dev/null
+++ b/srfi/sets/sets.sld
@@ -0,0 +1,45 @@
+(define-library (sets)
+  (import (scheme base))
+  (import (scheme case-lambda))
+  (import (scheme write))
+  (import (srfi 128)) ;(comparators))
+  (import (srfi 69))
+
+  (export set set-unfold)
+  (export set? set-contains? set-empty? set-disjoint?)
+  (export set-member set-element-comparator)
+  (export set-adjoin set-adjoin! set-replace set-replace!
+          set-delete set-delete! set-delete-all set-delete-all! set-search!)
+  (export set-size set-find set-count set-any? set-every?)
+  (export set-map set-for-each set-fold
+          set-filter set-remove set-remove set-partition
+          set-filter! set-remove! set-partition!)
+  (export set-copy set->list list->set list->set!)
+  (export set=? set<? set>? set<=? set>=?)
+  (export set-union set-intersection set-difference set-xor
+          set-union! set-intersection! set-difference! set-xor!)
+  (export set-comparator)
+  
+  (export bag bag-unfold)
+  (export bag? bag-contains? bag-empty? bag-disjoint?)
+  (export bag-member bag-element-comparator)
+  (export bag-adjoin bag-adjoin! bag-replace bag-replace!
+          bag-delete bag-delete! bag-delete-all bag-delete-all! bag-search!)
+  (export bag-size bag-find bag-count bag-any? bag-every?)
+  (export bag-map bag-for-each bag-fold
+          bag-filter bag-remove bag-partition
+          bag-filter! bag-remove! bag-partition!)
+  (export bag-copy bag->list list->bag list->bag!)
+  (export bag=? bag<? bag>? bag<=? bag>=?)
+  (export bag-union bag-intersection bag-difference bag-xor
+          bag-union! bag-intersection! bag-difference! bag-xor!)
+  (export bag-comparator)
+  
+  
+  (export bag-sum bag-sum! bag-product bag-product!
+          bag-unique-size bag-element-count bag-for-each-unique bag-fold-unique
+          bag-increment! bag-decrement! bag->set set->bag set->bag!
+          bag->alist alist->bag)
+
+  (include "sets-impl.scm")
+)