Merge pull request #5 from dpk/master

More extensive warning about the appropriateness of the name product

2 files changed, 30 insertions, 28 deletions

diff --git a/srfi-228.html b/srfi-228.html
index b407ae6..ba3074d 100644
--- a/srfi-228.html
+++ b/srfi-228.html
@@ -78,7 +78,7 @@
       </ul>
       <p>If the ordering predicate or the hash function of any of the given comparators does not exist, the corresponding procedure in the product comparator will also not exist.</p>
       <p>If there are no <var>comparator</var>s given, this procedure returns the <code>comparator-one</code>, or a new comparator with identical behaviour to it.</p>
-      <p><i>Note:</i> Despite the name, this procedure actually creates comparators which are more general than a comparator over a product type, because each of the given <var>comparator</var>s has its own type test.</p>
+      <p><i>Note:</i> This procedure actually creates comparators which are more general than a comparator over a product type – for example, because each <var>comparator</var> has its own type test, it can be used to combine a comparator for one type with that of a subtype; or if more than one <var>comparator</var> looks at the same component of a type. However, in most cases it is expected that this procedure will be used together with <code>make-wrapper-comparator</code> to create comparators over record types i.e. product types, hence the name.</p>
 
   <dt><code>(make-sum-comparator</code> <var>comparator</var> ... <code>)</code> (Procedure)
     <dd>
diff --git a/srfi/srfi-228.scm b/srfi/srfi-228.scm
index 9898d1e..139093f 100644
--- a/srfi/srfi-228.scm
+++ b/srfi/srfi-228.scm
@@ -18,7 +18,7 @@
 
 (define (make-product-comparator . comparators)
   (if (null? comparators)
-      one-comparator
+      comparator-one
       (let* ((type-tests
               (delete-duplicates
                (map comparator-type-test-predicate comparators)
@@ -56,35 +56,37 @@
    comparators))
 
 (define (make-sum-comparator . comparators)
-  (make-comparator
-   (lambda (x)
-     (any
-      (lambda (cmp)
-        ((comparator-type-test-predicate cmp) x))
-      comparators))
-   (lambda (a b)
-     (let ((a-cmp-idx (comparator-index comparators a))
-           (b-cmp-idx (comparator-index comparators b)))
-       (if (not (= a-cmp-idx b-cmp-idx))
-           #f
-           (let ((cmp (list-ref comparators a-cmp-idx)))
-             ((comparator-equality-predicate cmp) a b)))))
-   (if (every comparator-ordered? comparators)
+  (if (null? comparators)
+      comparator-zero
+      (make-comparator
+       (lambda (x)
+         (any
+          (lambda (cmp)
+            ((comparator-type-test-predicate cmp) x))
+          comparators))
        (lambda (a b)
          (let ((a-cmp-idx (comparator-index comparators a))
                (b-cmp-idx (comparator-index comparators b)))
-           (cond ((< a-cmp-idx b-cmp-idx) #t)
-                 ((> a-cmp-idx b-cmp-idx) #f)
-                 (else
-                  (let ((cmp (list-ref comparators a-cmp-idx)))
-                    ((comparator-ordering-predicate cmp) a b))))))
-       #f)
-   (if (every comparator-hashable? comparators)
-       (lambda (x)
-         (let ((cmp (find (lambda (cmp) ((comparator-type-test-predicate cmp) x))
-                          comparators)))
-           ((comparator-hash-function cmp) x)))
-       #f)))
+           (if (not (= a-cmp-idx b-cmp-idx))
+               #f
+               (let ((cmp (list-ref comparators a-cmp-idx)))
+                 ((comparator-equality-predicate cmp) a b)))))
+       (if (every comparator-ordered? comparators)
+           (lambda (a b)
+             (let ((a-cmp-idx (comparator-index comparators a))
+                   (b-cmp-idx (comparator-index comparators b)))
+               (cond ((< a-cmp-idx b-cmp-idx) #t)
+                     ((> a-cmp-idx b-cmp-idx) #f)
+                     (else
+                      (let ((cmp (list-ref comparators a-cmp-idx)))
+                        ((comparator-ordering-predicate cmp) a b))))))
+           #f)
+       (if (every comparator-hashable? comparators)
+           (lambda (x)
+             (let ((cmp (find (lambda (cmp) ((comparator-type-test-predicate cmp) x))
+                              comparators)))
+               ((comparator-hash-function cmp) x)))
+           #f))))
 
 (define comparator-one
   (make-comparator