> Definitely not.
Yes you are correct. I was trying to rationalize why the sample
implementation was doing what it did.
> I agree.
Here is a patch that applies Rutger's fixes and changes the tests. (The
implementation also didn't return `#f` when applying `(disjoin)`, and
that is fixed too.)
All tests pass in Chibi.
diff --git a/srfi-235-test.scm b/srfi-235-test.scm
index 153686d..240e958 100644
--- a/srfi-235-test.scm
+++ b/srfi-235-test.scm
@@ -86,16 +86,19 @@
"conjoin"
(test-assert
- ((conjoin number? exact?)))
+ ((conjoin number? exact?) 1))
(test-assert
- ((conjoin number? exact?) 1 2))
+ ((conjoin eqv? equal?) 1 1))
(test-assert
- (not ((conjoin number? exact?) 1 2.)))
+ (not ((conjoin equal? eq?) (list 1) (list 1))))
(test-assert
- ((conjoin) 1 2)))
+ (not ((conjoin number? exact?) 2.)))
+
+ (test-assert
+ ((conjoin))))
@@ -103,16 +106,19 @@
"disjoin"
(test-assert
- ((disjoin number? string?)))
+ ((disjoin number? string?) 1))
+
+ (test-assert
+ ((disjoin eqv? equal?) (list 1) (list 1)))
(test-assert
- ((disjoin number? string?) 1 "a"))
+ ((disjoin number? string?) "a"))
(test-assert
- (not ((disjoin number? string?) 'a 'b)))
+ (not ((disjoin number? string?) 'a)))
(test-assert
- (not ((disjoin) 1 2))))
+ (not ((disjoin)))))
diff --git a/srfi/235-impl.scm b/srfi/235-impl.scm
index 3ba6a95..23554bf 100644
--- a/srfi/235-impl.scm
+++ b/srfi/235-impl.scm
@@ -23,30 +23,12 @@
(proc obj2)))
(define (conjoin . predicates)
- (case-lambda
- (() #t)
- (args (let loop-args ((args args))
- (if (null? args)
- #t
- (let ((arg (car args)))
- (let loop-preds ((predicates predicates))
- (cond
- ((null? predicates) (loop-args (cdr args)))
- ((not ((car predicates) arg)) #f)
- (else (loop-preds (cdr predicates)))))))))))
+ (lambda args
+ (every (lambda (proc) (apply proc args)) predicates)))
(define (disjoin . predicates)
- (case-lambda
- (() #t)
- (args (let loop-args ((args args))
- (if (null? args)
- #t
- (let ((arg (car args)))
- (let loop-preds ((predicates predicates))
- (cond
- ((null? predicates) #f)
- (((car predicates) arg) (loop-args (cdr args)))
- (else (loop-preds (cdr predicates)))))))))))
+ (lambda args
+ (any (lambda (proc) (apply proc args)) predicates)))
(define (each-of . procs)
(lambda args