> 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



Reply via email to