Specify base cases and behaviours of each comparator function

4 files changed, 85 insertions, 36 deletions

diff --git a/srfi-228.html b/srfi-228.html
index 6e07d7d..ba54b5a 100644
--- a/srfi-228.html
+++ b/srfi-228.html
@@ -45,6 +45,8 @@
 
 <p>All identifiers defined in this SRFI are exported in the <code>(srfi 228)</code> library. However, as in the case of SRFI 162, it is hoped and intended that they will simply be added to the existing comparator libraries of RnRSes and Scheme implementations, rather than being in a separate library.
 
+<h3 id=constructors>Constructors</h3>
+
 <dl>
   <dt><code>(make-wrapper-comparator</code> <var>type-test</var> <var>unwrap</var> <var>contents-comparator</var><code>)</code> (Procedure)
     <dd>
@@ -52,11 +54,59 @@
 
   <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. The hash function of the product comparator hashes together the results of all the given comparators in an implementation-defined way. 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>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
+      <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>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>
+            <li>if the current comparator’s ordering predicate returns true, the ordering predicate of the product comparator returns <code>#t</code>;
+            <li>if the current comparator’s equality predicate returns true, the next comparator is checked; or
+            <li>if there are no more comparators left, the ordering predicate of the product comparator returns <code>#f</code>;
+          </ul>
+          and whose
+        <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><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. The hash function of the sum comparator returns the value of the hash function of the leftmost comparator whose type-test is satisfied by the given value. 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>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
+      <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.
+      </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>
+</dl>
+
+<h3 id=base-cases>Base Cases</h3>
+
+<dl>
+  <dt><code>one-comparator</code> (Comparator)
+    <dd>
+      <p>A comparator whose
+      <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)
+    <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>
 
 <h2 id=examples>Examples</h2>
@@ -131,9 +181,13 @@
 
 <p><code>make-sum-comparator</code>, and by extension the inspiration for the name of <code>make-product-comparator</code>, is originally from Adam Nelson’s Schemepunk.
 
-<p>Jakob Wuhrer pointed out bugs in the sample implementation.
+<p>Shiro Kawai requested a clearer definition of the individual procedures of sum and product comparators. He also suggested defining the base cases of <code>make-product-comparator</code> and <code>make-sum-comparator</code>; Jakob Wuhrer produced a detailed analysis showing the correct behaviour of the base cases <code>one-comparator</code> and <code>zero-comparator</code>, and also pointed out bugs in the sample implementation.
+
+<p>Lassi Kortela and Marc Nieper-Wißkirchen pointed out that the names <code>make-product-comparator</code> and <code>make-sum-comparator</code> are confusing and, in the former case, slightly incorrect in the analogy to product types of type theory. However, since nobody on the list could come up with a better name which makes clear what the two comparator compositions do, and their relationship to one another, the names were retained.
+
+<p>Arthur Gleckler was extraordinarily patient.
 
-<h2 id=future-work>Future work</h2>
+<h2 id=future-work>Future Work</h2>
 
 <p>The author hopes that a future SRFI will add a procedure for creating comparators yielding lexicographical order over any sequence type by delegating to a common iteration protocol. An idea to do this using <code>fold</code> procedures foundered on two grounds: the first and more intrinsic one is that <code>fold</code> called on two sequences, one of which is a prefix of the other, cannot determine which of the two is longer, and a sort using <code>fold</code>-based iteration would incorrectly consider them equal; the second is that there is currently an inconsistency among Scheme libraries in what order the <var>kons</var> procedure argument to <code>fold</code> receives the accumulator and the next values in the sequence (compare <a href="https://srfi.schemers.org/srfi-1/srfi-1.html#fold">SRFI 1 <code>fold</code></a> with <a href="https://srfi.schemers.org/srfi-133/srfi-133.html#vector-fold">SRFI 133 <code>vector-fold</code></a>). <a href="https://srfi.schemers.org/srfi-158/srfi-158.html">SRFI 158</a> generators were rejected on the ground that their sequences cannot contain any arbitrary Scheme datum.
 
diff --git a/228.sld b/srfi/228.sld
index 3417d76..b3cca89 100644
--- a/228.sld
+++ b/srfi/228.sld
@@ -1,9 +1,10 @@
 (define-library (srfi 228)
-  (import (srfi 1)
-          (srfi 128))
+  (import (scheme base)
+          (srfi 1)
+          (srfi 128)
+          (srfi 151))
   (export make-wrapper-comparator
           make-product-comparator
-          make-sum-comparator
-          comparison-procedures)
+          make-sum-comparator)
 
   (include "composing-comparators.scm"))
diff --git a/composing-comparators.scm b/srfi/composing-comparators.scm
index 1591fbc..3a93ae4 100644
--- a/composing-comparators.scm
+++ b/srfi/composing-comparators.scm
@@ -47,11 +47,16 @@
                       comparators)))
          #f))))
 
-(define (comparator-index comparators val)
-  (list-index
-   (lambda (cmp)
-     ((comparator-type-test-predicate cmp) val))
-   comparators))
+(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? a) comparators)))
+          (if (and b-cmp ((comparator-type-test-predicate (car b-cmp)) a))
+              b-cmp
+              #f)))))
 
 (define (make-sum-comparator . comparators)
   (make-comparator
@@ -61,33 +66,22 @@
         ((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)))))
+     (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 ((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))))))
+         (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 (find (lambda (cmp) ((comparator-type-test-predicate cmp) x))
-                          comparators)))
-           ((comparator-hash-function cmp) x)))
+         (let ((cmp (%sum-comparator-for comparators x x)))
+           ((comparator-hash-function (car cmp)) x)))
        #f)))
 
-(define (comparison-procedures comparator)
-  (values
-   (lambda args (apply <? comparator args))
-   (lambda args (apply <=? comparator args))
-   (lambda args (apply =? comparator args))
-   (lambda args (apply >=? comparator args))
-   (lambda args (apply >? comparator args))))
diff --git a/composing-comparators-test.scm b/test.scm
index 305a4dc..305a4dc 100644
--- a/composing-comparators-test.scm
+++ b/test.scm