Commit 13cfae2b authored by Kilian Sprotte's avatar Kilian Sprotte
Browse files

Fixed conjoin single predicate bug; more tests


Added new test cases for DISJOIN, CONJOIN, COMPOSE and MULTIPLE-VALUE-COMPOSE.
All of them testing for the edge case of a single predicate / function.
parent a90f804a
......@@ -37,16 +37,18 @@ If none of the predicates returns true, NIL is returned."
functions in turn to its arguments, returning NIL if any of the predicates
returns false, without calling the remaining predicates. If none of the
predicates returns false, returns the primary value of the last predicate."
(lambda (&rest arguments)
(and (apply predicate arguments)
;; Cannot simply use CL:EVERY because we want to return the
;; non-NIL value of the last predicate if all succeed.
(do ((tail (cdr more-predicates) (cdr tail))
(head (car more-predicates) (car tail)))
((not tail)
(apply head arguments))
(unless (apply head arguments)
(return nil))))))
(if (null more-predicates)
predicate
(lambda (&rest arguments)
(and (apply predicate arguments)
;; Cannot simply use CL:EVERY because we want to return the
;; non-NIL value of the last predicate if all succeed.
(do ((tail (cdr more-predicates) (cdr tail))
(head (car more-predicates) (car tail)))
((not tail)
(apply head arguments))
(unless (apply head arguments)
(return nil)))))))
(defun compose (function &rest more-functions)
......@@ -79,7 +81,7 @@ and then calling the next one with the primary value of the last."
(defun multiple-value-compose (function &rest more-functions)
"Returns a function composed of FUNCTION and MORE-FUNCTIONS that applies
its arguments to to each in turn, starting from the rightmost of
its arguments to each in turn, starting from the rightmost of
MORE-FUNCTIONS, and then calling the next one with all the return values of
the last."
(declare (optimize (speed 3) (safety 1) (debug 1)))
......
......@@ -346,6 +346,12 @@
(funcall disjunction "test")))
(nil :cons :string))
(deftest disjoin.2
(let ((disjunction (disjoin #'zerop)))
(list (funcall disjunction 0)
(funcall disjunction 1)))
(t nil))
(deftest conjoin.1
(let ((conjunction (conjoin #'consp
(lambda (x)
......@@ -357,6 +363,12 @@
(funcall conjunction '("foo"))))
(nil nil #\f))
(deftest conjoin.2
(let ((conjunction (conjoin #'zerop)))
(list (funcall conjunction 0)
(funcall conjunction 1)))
(t nil))
(deftest compose.1
(let ((composite (compose '1+
(lambda (x)
......@@ -386,6 +398,12 @@
(funcall fun "3")))
7)
(deftest compose.4
(let ((composite (compose #'zerop)))
(list (funcall composite 0)
(funcall composite 1)))
(t nil))
(deftest multiple-value-compose.1
(let ((composite (multiple-value-compose
#'truncate
......@@ -423,6 +441,11 @@
(multiple-value-list (funcall fun "2 9"))))
(4 1))
(deftest multiple-value-compose.4
(let ((composite (multiple-value-compose #'truncate)))
(multiple-value-list (funcall composite 9 2)))
(4 1))
(deftest curry.1
(let ((curried (curry '+ 3)))
(funcall curried 1 5))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment