Revert changes to the semantics of sum-comparator

Also changed one-comparator and zero-comparator back to comparator-one
and comparator-zero, because they’re comparators which are of the
effect of one or zero, rather than comparators for the values 1 and 0.

3 files changed, 57 insertions, 60 deletions

diff --git a/srfi-228.html b/srfi-228.html
index 598ccbf..f621ddc 100644
--- a/srfi-228.html
+++ b/srfi-228.html
@@ -7,8 +7,14 @@
   <link rel="stylesheet" href="https://srfi.schemers.org/srfi.css" type="text/css">
   <style>
     .issue {
-    background-color: pink;
-    padding: 0.5em;
+        background-color: pink;
+        padding: 0.5em;
+    }
+
+    var {
+        font-family: serif;
+        font-style: italic;
+        font-size-adjust: ex-height;
     }
   </style>
   <meta name="viewport" content="width=device-width, initial-scale=1"></head>
@@ -56,9 +62,9 @@
   <dt><code>(make-product-comparator</code> <var>comparator</var> ... <code>)</code> (Procedure)
     <dd>
       <p>Returns a comparator which compares values satisfying the type tests of all of the given <var>comparator</var>s by comparing them with each of the given comparators in turn, left to right, and returning the result of the first non-equal comparison. If all the given comparators consider two values equal, the product comparator also considers them equal.</p>
-      <p>Specifically, returns a comparator whose
+      <p>The product comparator is formally defined as follows. The domain of the product comparator is the intersection of the domains of all the given <var>comparator</var>s. The product comparator is then a comparator whose
       <ul>
-        <li><b>type test</b> returns <code>#t</code> if all of the <var>comparator</var>s’ type tests return <code>#t</code>, otherwise returning <code>#f</code>;
+        <li><b>type test</b> returns <code>#t</code> if all of the <var>comparator</var>s’ type tests are satisfied by the given value, otherwise returning <code>#f</code>;
         <li><b>equality predicate</b> returns <code>#t</code> if the given values are equal according to the equality predicates of all the <var>comparator</var>s, otherwise returning <code>#f</code>;
         <li><b>ordering predicate</b>, given two arguments <var>a b</var>, compared them using each of the <var>comparator</var>s from left to right thus:
           <ul>
@@ -70,42 +76,36 @@
         <li><b>hash function</b> hashes together the results of applying each of the <var>comparator</var>s’ hash functions to the given value in an implementation-defined way.
       </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>one-comparator</code>, or a new comparator with identical behaviour to it.</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>
 
   <dt><code>(make-sum-comparator</code> <var>comparator</var> ... <code>)</code> (Procedure)
     <dd>
       <p>Returns a comparator which compares values satisfying the type-tests of any of the given comparators, such that values which satisfy the type-test of a given comparator are ordered before any values satisfying the type-tests of any comparators appear to the right of it, and values satisfying the same comparator’s type-test are tested for ordering and equality according that comparator.</p>
-      <p>Specifically, returns a comparator whose
+      <p>The sum comparator is formally defined as follows. The domain of the sum comparator is the union of the domains of all the given <var>comparator</var>s. The <dfn>relevant comparator</dfn> for a given value is the leftmost of the given <var>comparator</var>s whose type test answers true for that value. The sum comparator is then a comparator whose
       <ul>
-        <li><b>type test</b> returns <code>#t</code> if any of the <var>comparator</var>s’ type tests return <code>#t</code>, otherwise returning <code>#f</code>;
-        <li><b>equality predicate</b> returns the value returned by the leftmost <var>comparator</var> whose type test is satisfied by both of the two given values, and if there is no such <var>comparator</var>, returns <code>#f</code>;
-        <li><b>ordering predicate</b>, given two arguments <var>a b</var>:
-          <ul>
-            <li>returns the value returned by the leftmost <var>comparator</var> whose type test is satisfied by both of the two given values;
-            <li>if there is no such <var>comparator</var>, returns <code>#t</code> if the leftmost <var>comparator</var> whose type test is satisfied by the value <var>a</var> is to the left of the leftmost <var>comparator</var> whose type test is satisfied by value <var>b</var>; and which
-              <li>otherwise returns <code>#f</code>;
-          </ul>
-          and whose
-        <li><b>hash function</b> returns the value returned by the hash function of the leftmost <var>comparator</var> whose type test is satisfied by the given value.
+        <li><b>type test</b> returns <code>#t</code> if there exists a relevant comparator for the given value, or otherwise <code>#f</code>;
+        <li><b>equality predicate</b> finds the relevant comparators for both of the values it is given. If the values have two different relevant comparators, it returns <code>#f</code>; otherwise, it returns the value of the equality predicate of the relevant comparator applied to the two values.
+        <li><b>ordering predicate</b> finds the relevant comparators for both of the values (<var>a b</var>) it is given. If the relevant comparator for <var>a</var> is to the left of the relevant comparator for <var>b</var>, it returns <var>#t</var>. If the two values have the same relevant comparator, it returns the value returned by the ordering predicate of that comparator applied to the two values. In all other cases, returns <var>#f</var>.
+        <li><b>hash function</b> returns the value returned by the hash function of the relevant comparator for the value it is given.
       </ul>
       <p>If the ordering predicate or the hash function of any of the given comparators does not exist, the corresponding procedure in the sum comparator will also not exist.</p>
-      <p>If there are no <var>comparator</var>s given, this procedure returns the <code>zero-comparator</code>, or a new comparator with identical behaviour to it.</p>
+      <p>If there are no <var>comparator</var>s given, this procedure returns the <code>comparator-zero</code>, or a new comparator with identical behaviour to it.</p>
 </dl>
 
 <h3 id=base-cases>Base Cases</h3>
 
 <dl>
-  <dt><code>one-comparator</code> (Comparator)
+  <dt><code>comparator-one</code> (Comparator)
     <dd>
-      <p>A comparator whose
+      <p>A comparator which has all values in its domain and considers all values to be equal. Specifically, its:
       <ul>
         <li><b>type test</b> always returns <code>#t</code>;
         <li><b>equality predicate</b> always returns <code>#t</code>;
         <li><b>ordering predicate</b> always returns <code>#f</code>; and whose
         <li><b>hash function</b> always returns <code>0</code>.
       </ul>
-  <dt><code>zero-comparator</code> (Comparator)
+  <dt><code>comparator-zero</code> (Comparator)
     <dd>
       <p>A comparator whose type test always returns <code>#f</code>. Since this comparator has no values in its domain, it is always an error to invoke its equality predicate, ordering predicate, or hash function.
 </dl>
diff --git a/srfi/228.sld b/srfi/228.sld
index ebec908..611d5a9 100644
--- a/srfi/228.sld
+++ b/srfi/228.sld
@@ -7,6 +7,6 @@
           make-product-comparator
           make-sum-comparator
 
-          one-comparator
-          zero-comparator)
+          comparator-one
+          comparator-zero)
   (include "srfi-228.scm"))
diff --git a/srfi/srfi-228.scm b/srfi/srfi-228.scm
index 06aae19..9898d1e 100644
--- a/srfi/srfi-228.scm
+++ b/srfi/srfi-228.scm
@@ -49,54 +49,51 @@
                           comparators)))
              #f)))))
 
-(define (%sum-comparator-for comparators a b)
-  (define (type-tests-for? x)
-    (lambda (cmp) ((comparator-type-test-predicate cmp) x)))
-  (let ((a-cmp (find-tail (type-tests-for? a) comparators)))
-    (if (and a-cmp ((comparator-type-test-predicate (car a-cmp)) b))
-        a-cmp
-        (let ((b-cmp (find-tail (type-tests-for? b) comparators)))
-          (if (and b-cmp ((comparator-type-test-predicate (car b-cmp)) a))
-              b-cmp
-              #f)))))
+(define (comparator-index comparators val)
+  (list-index
+   (lambda (cmp)
+     ((comparator-type-test-predicate cmp) val))
+   comparators))
 
 (define (make-sum-comparator . comparators)
-  (if (null? comparators)
-      zero-comparator
-      (make-comparator
-       (lambda (x)
-         (any
-          (lambda (cmp)
-            ((comparator-type-test-predicate cmp) x))
-          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)
        (lambda (a b)
-         (let ((cmp (%sum-comparator-for comparators a b)))
-           (if cmp
-               ((comparator-equality-predicate (car cmp)) a b)
-               #f)))
-       (if (every comparator-ordered? comparators)
-           (lambda (a b)
-             (let ((cmp (%sum-comparator-for comparators a b)))
-               (if cmp
-                   ((comparator-ordering-predicate (car cmp)) a b)
-                   (let ((a-cmp (%sum-comparator-for comparators a a))
-                         (b-cmp (%sum-comparator-for comparators b b)))
-                     (>= (length a-cmp) (length b-cmp))))))
-           #f)
-       (if (every comparator-hashable? comparators)
-           (lambda (x)
-             (let ((cmp (%sum-comparator-for comparators x x)))
-               ((comparator-hash-function (car cmp)) x)))
-           #f))))
+         (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 one-comparator
+(define comparator-one
   (make-comparator
    (lambda (x) #t)
    (lambda (a b) #t)
    (lambda (a b) #f)
    (lambda (x) 0)))
 
-(define zero-comparator
+(define comparator-zero
   (make-comparator
    (lambda (x) #f)
    (lambda (a b) (error "can't compare" a b))