diff options
| author | 2022-12-08 09:46:08 +0100 | |
|---|---|---|
| committer | 2022-12-08 09:46:08 +0100 | |
| commit | 0ab70d55e62c9410294dc1197e46a62eeabe661d (patch) | |
| tree | 6c32812e28fa605dffd0d673207337caab48a792 | |
| parent | Markup and base case reference fix (diff) | |
Restore explicit use of base cases
| -rw-r--r-- | srfi/srfi-228.scm | 56 |
1 files changed, 29 insertions, 27 deletions
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 |
