summaryrefslogtreecommitdiffstats
path: root/composing-comparators.scm
diff options
context:
space:
mode:
authorGravatar Arthur A. Gleckler 2022-10-22 10:00:16 -0700
committerGravatar GitHub 2022-10-22 10:00:16 -0700
commitccacfd5b00feae644041d13c425f06442bdc3fa8 (patch)
treef1d69993b0fff2ab5c0dcda3e8f070f63068928b /composing-comparators.scm
parentPublish second draft. (diff)
parentMerge 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.scm34
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)))