diff options
| author | 2022-10-22 10:00:16 -0700 | |
|---|---|---|
| committer | 2022-10-22 10:00:16 -0700 | |
| commit | ccacfd5b00feae644041d13c425f06442bdc3fa8 (patch) | |
| tree | f1d69993b0fff2ab5c0dcda3e8f070f63068928b /composing-comparators.scm | |
| parent | Publish second draft. (diff) | |
| parent | Merge branch 'master' of https://github.com/scheme-requests-for-implementatio... (diff) | |
Merge pull request #2 from dpk/master
Address outstanding issues
Diffstat (limited to 'composing-comparators.scm')
| -rw-r--r-- | composing-comparators.scm | 34 |
1 files changed, 15 insertions, 19 deletions
diff --git a/composing-comparators.scm b/composing-comparators.scm index d121698..1591fbc 100644 --- a/composing-comparators.scm +++ b/composing-comparators.scm @@ -26,13 +26,11 @@ (every (lambda (test) (test val)) type-tests)))) (make-comparator type-test - (if (every comparator-equality-predicate comparators) - (lambda (a b) - (every (lambda (cmp) - ((comparator-equality-predicate cmp) a b)) - comparators)) - #f) - (if (every comparator-ordering-predicate comparators) + (lambda (a b) + (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) @@ -40,7 +38,7 @@ (((comparator-equality-predicate (car cmps)) a b) (loop (cdr cmps))) (else #f)))) #f) - (if (every comparator-hash-function comparators) + (if (every comparator-hashable? comparators) (lambda (x) (fold bitwise-xor 0 @@ -62,16 +60,14 @@ (lambda (cmp) ((comparator-type-test-predicate cmp) x)) comparators)) - (if (every comparator-equality-predicate 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))))) - #f) - (if (every comparator-ordering-predicate 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 ((a-cmp-idx (comparator-index comparators a)) (b-cmp-idx (comparator-index comparators b))) @@ -81,7 +77,7 @@ (let ((cmp (list-ref comparators a-cmp-idx))) ((comparator-ordering-predicate cmp) a b)))))) #f) - (if (every comparator-hash-function comparators) + (if (every comparator-hashable? comparators) (lambda (x) (let ((cmp (find (lambda (cmp) ((comparator-type-test-predicate cmp) x)) comparators))) |
