Handle the base cases explicitly to be safe

1 files changed, 54 insertions, 50 deletions

diff --git a/srfi/srfi-228.scm b/srfi/srfi-228.scm
index b90db54..06aae19 100644
--- a/srfi/srfi-228.scm
+++ b/srfi/srfi-228.scm
@@ -17,35 +17,37 @@
       #f)))
 
 (define (make-product-comparator . comparators)
-  (let* ((type-tests
-          (delete-duplicates
-           (map comparator-type-test-predicate comparators)
-           eq?))
-         (type-test
-          (lambda (val)
-            (every (lambda (test) (test val)) type-tests))))
-    (make-comparator
-     type-test
-     (lambda (a b)
-       (every (lambda (cmp)
-                ((comparator-equality-predicate cmp) a b))
-              comparators))
-     (if (every comparator-ordered? comparators)
+  (if (null? comparators)
+      one-comparator
+      (let* ((type-tests
+              (delete-duplicates
+               (map comparator-type-test-predicate comparators)
+               eq?))
+             (type-test
+              (lambda (val)
+                (every (lambda (test) (test val)) type-tests))))
+        (make-comparator
+         type-test
          (lambda (a b)
-           (let loop ((cmps comparators))
-             (cond ((null? cmps) #f)
-                   (((comparator-ordering-predicate (car cmps)) a b) #t)
-                   (((comparator-equality-predicate (car cmps)) a b) (loop (cdr cmps)))
-                   (else #f))))
-         #f)
-     (if (every comparator-hashable? comparators)
-         (lambda (x)
-           (fold bitwise-xor
-                 0
-                 (map (lambda (cmp)
-                        ((comparator-hash-function cmp) x))
-                      comparators)))
-         #f))))
+           (every (lambda (cmp)
+                    ((comparator-equality-predicate cmp) a b))
+                  comparators))
+         (if (every comparator-ordered? comparators)
+             (lambda (a b)
+               (let loop ((cmps comparators))
+                 (cond ((null? cmps) #f)
+                       (((comparator-ordering-predicate (car cmps)) a b) #t)
+                       (((comparator-equality-predicate (car cmps)) a b) (loop (cdr cmps)))
+                       (else #f))))
+             #f)
+         (if (every comparator-hashable? comparators)
+             (lambda (x)
+               (fold bitwise-xor
+                     0
+                     (map (lambda (cmp)
+                            ((comparator-hash-function cmp) x))
+                          comparators)))
+             #f)))))
 
 (define (%sum-comparator-for comparators a b)
   (define (type-tests-for? x)
@@ -59,31 +61,33 @@
               #f)))))
 
 (define (make-sum-comparator . comparators)
-  (make-comparator
-   (lambda (x)
-     (any
-      (lambda (cmp)
-        ((comparator-type-test-predicate cmp) x))
-      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)
+  (if (null? comparators)
+      zero-comparator
+      (make-comparator
+       (lambda (x)
+         (any
+          (lambda (cmp)
+            ((comparator-type-test-predicate cmp) x))
+          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)))
+               ((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))))
 
 (define one-comparator
   (make-comparator