Adds the every-pred and some-fn combinators and their tests. refs. CLJ-729

Signed-off-by: Stuart Halloway <stu@Orolo-2.local>

2 files changed, 280 insertions, 0 deletions

diff --git a/src/clj/clojure/core.clj b/src/clj/clojure/core.clj
index 0f6a332a..4a6f7761 100644
--- a/src/clj/clojure/core.clj
+++ b/src/clj/clojure/core.clj
@@ -6204,6 +6204,86 @@
      ([a b c] (f (if (nil? a) x a) (if (nil? b) y b) (if (nil? c) z c)))
      ([a b c & ds] (apply f (if (nil? a) x a) (if (nil? b) y b) (if (nil? c) z c) ds)))))
 
+(defn every-pred
+  "Takes a set of predicates and returns a function f that returns true if all of its
+  composing predicates return a logical true value against all of its arguments, else it returns
+  false. Note that f is short-circuiting in that it will stop execution on the first
+  argument that triggers a logical false result against the original predicates."
+  {:added "1.3"}
+  ([p]
+     (fn ep1
+       ([] true)
+       ([x] (boolean (p x)))
+       ([x y] (boolean (and (p x) (p y))))
+       ([x y z] (boolean (and (p x) (p y) (p z))))
+       ([x y z & args] (boolean (and (ep1 x y z)
+                                     (every? p args))))))
+  ([p1 p2]
+     (fn ep2
+       ([] true)
+       ([x] (boolean (and (p1 x) (p2 x))))
+       ([x y] (boolean (and (p1 x) (p1 y) (p2 x) (p2 y))))
+       ([x y z] (boolean (and (p1 x) (p1 y) (p1 z) (p2 x) (p2 y) (p2 z))))
+       ([x y z & args] (boolean (and (ep2 x y z)
+                                     (every? #(and (p1 %) (p2 %)) args))))))
+  ([p1 p2 p3]
+     (fn ep3
+       ([] true)
+       ([x] (boolean (and (p1 x) (p2 x) (p3 x))))
+       ([x y] (boolean (and (p1 x) (p2 x) (p3 x) (p1 y) (p2 y) (p3 y))))
+       ([x y z] (boolean (and (p1 x) (p2 x) (p3 x) (p1 y) (p2 y) (p3 y) (p1 z) (p2 z) (p3 z))))
+       ([x y z & args] (boolean (and (ep3 x y z)
+                                     (every? #(and (p1 %) (p2 %) (p3 %)) args))))))
+  ([p1 p2 p3 & ps]
+     (let [ps (list* p1 p2 p3 ps)]
+       (fn epn
+         ([] true)
+         ([x] (every? #(% x) ps))
+         ([x y] (every? #(and (% x) (% y)) ps))
+         ([x y z] (every? #(and (% x) (% y) (% z)) ps))
+         ([x y z & args] (boolean (and (epn x y z)
+                                       (every? #(every? % args) ps))))))))
+
+(defn some-fn
+  "Takes a set of predicates and returns a function f that returns the first logical true value
+  returned by one of its composing predicates against any of its arguments, else it returns
+  logical false. Note that f is short-circuiting in that it will stop execution on the first
+  argument that triggers a logical true result against the original predicates."
+  {:added "1.3"}
+  ([p]
+     (fn sp1
+       ([] nil)
+       ([x] (p x))
+       ([x y] (or (p x) (p y)))
+       ([x y z] (or (p x) (p y) (p z)))
+       ([x y z & args] (or (sp1 x y z)
+                           (some p args)))))
+  ([p1 p2]
+     (fn sp2
+       ([] nil)
+       ([x] (or (p1 x) (p2 x)))
+       ([x y] (or (p1 x) (p1 y) (p2 x) (p2 y)))
+       ([x y z] (or (p1 x) (p1 y) (p1 z) (p2 x) (p2 y) (p2 z)))
+       ([x y z & args] (or (sp2 x y z)
+                           (some #(or (p1 %) (p2 %)) args)))))
+  ([p1 p2 p3]
+     (fn sp3
+       ([] nil)
+       ([x] (or (p1 x) (p2 x) (p3 x)))
+       ([x y] (or (p1 x) (p2 x) (p3 x) (p1 y) (p2 y) (p3 y)))
+       ([x y z] (or (p1 x) (p2 x) (p3 x) (p1 y) (p2 y) (p3 y) (p1 z) (p2 z) (p3 z)))
+       ([x y z & args] (or (sp3 x y z)
+                           (some #(or (p1 %) (p2 %) (p3 %)) args)))))
+  ([p1 p2 p3 & ps]
+     (let [ps (list* p1 p2 p3 ps)]
+       (fn spn
+         ([] nil)
+         ([x] (some #(% x) ps))
+         ([x y] (some #(or (% x) (% y)) ps))
+         ([x y z] (some #(or (% x) (% y) (% z)) ps))
+         ([x y z & args] (or (spn x y z)
+                             (some #(some % args) ps)))))))
+
 (defn- ^{:dynamic true} assert-valid-fdecl
   "A good fdecl looks like (([a] ...) ([a b] ...)) near the end of defn."
   [fdecl]
diff --git a/test/clojure/test_clojure/other_functions.clj b/test/clojure/test_clojure/other_functions.clj
index 550b4df0..3848a166 100644
--- a/test/clojure/test_clojure/other_functions.clj
+++ b/test/clojure/test_clojure/other_functions.clj
@@ -90,6 +90,206 @@
 ; complement
 ; constantly
 
+; every-pred
+(deftest test-every-pred
+  (are [result expr] (= result expr)
+   ;; 1 pred
+   true     ((every-pred even?))
+   true     ((every-pred even?) 2)
+   true     ((every-pred even?) 2 4)
+   true     ((every-pred even?) 2 4 6)
+   true     ((every-pred even?) 2 4 6 8)
+   true     ((every-pred even?) 2 4 6 8 10)
+   false    ((every-pred odd?) 2)
+   false    ((every-pred odd?) 2 4)
+   false    ((every-pred odd?) 2 4 6)
+   false    ((every-pred odd?) 2 4 6 8)
+   false    ((every-pred odd?) 2 4 6 8 10)
+   ;; 2 preds
+   true     ((every-pred even? number?))
+   true     ((every-pred even? number?) 2)
+   true     ((every-pred even? number?) 2 4)
+   true     ((every-pred even? number?) 2 4 6)
+   true     ((every-pred even? number?) 2 4 6 8)
+   true     ((every-pred even? number?) 2 4 6 8 10)
+   false    ((every-pred number? odd?) 2)
+   false    ((every-pred number? odd?) 2 4)
+   false    ((every-pred number? odd?) 2 4 6)
+   false    ((every-pred number? odd?) 2 4 6 8)
+   false    ((every-pred number? odd?) 2 4 6 8 10)
+   ;; 2 preds, short-circuiting
+   false    ((every-pred number? odd?) 1 :a)
+   false    ((every-pred number? odd?) 1 3 :a)
+   false    ((every-pred number? odd?) 1 3 5 :a)
+   false    ((every-pred number? odd?) 1 3 5 7 :a)
+   false    ((every-pred number? odd?) 1 :a 3 5 7)
+   ;; 3 preds
+   true     ((every-pred even? number? #(> % 0)))
+   true     ((every-pred even? number? #(> % 0)) 2)
+   true     ((every-pred even? number? #(> % 0)) 2 4)
+   true     ((every-pred even? number? #(> % 0)) 2 4 6)
+   true     ((every-pred even? number? #(> % 0)) 2 4 6 8)
+   true     ((every-pred even? number? #(> % 0)) 2 4 6 8 10)
+   true     ((every-pred number? even? #(> % 0)) 2 4 6 8 10 12)
+   false    ((every-pred number? odd? #(> % 0)) 2)
+   false    ((every-pred number? odd? #(> % 0)) 2 4)
+   false    ((every-pred number? odd? #(> % 0)) 2 4 6)
+   false    ((every-pred number? odd? #(> % 0)) 2 4 6 8)
+   false    ((every-pred number? odd? #(> % 0)) 2 4 6 8 10)
+   false    ((every-pred number? odd? #(> % 0)) 2 4 6 8 -10)
+   ;; 3 preds, short-circuiting
+   false    ((every-pred number? odd? #(> % 0)) 1 :a)
+   false    ((every-pred number? odd? #(> % 0)) 1 3 :a)
+   false    ((every-pred number? odd? #(> % 0)) 1 3 5 :a)
+   false    ((every-pred number? odd? #(> % 0)) 1 3 5 7 :a)
+   false    ((every-pred number? odd? #(> % 0)) 1 :a 3 5 7)
+   ;; 4 preds
+   true     ((every-pred even? number? #(> % 0) #(<= % 12)))
+   true     ((every-pred even? number? #(> % 0) #(<= % 12)) 2)
+   true     ((every-pred even? number? #(> % 0) #(<= % 12)) 2 4)
+   true     ((every-pred even? number? #(> % 0) #(<= % 12)) 2 4 6)
+   true     ((every-pred even? number? #(> % 0) #(<= % 12)) 2 4 6 8)
+   true     ((every-pred even? number? #(> % 0) #(<= % 12)) 2 4 6 8 10)
+   true     ((every-pred number? even? #(> % 0) #(<= % 12)) 2 4 6 8 10 12)
+   false    ((every-pred number? odd? #(> % 0) #(<= % 12)) 2)
+   false    ((every-pred number? odd? #(> % 0) #(<= % 12)) 2 4)
+   false    ((every-pred number? odd? #(> % 0) #(<= % 12)) 2 4 6)
+   false    ((every-pred number? odd? #(> % 0) #(<= % 12)) 2 4 6 8)
+   false    ((every-pred number? odd? #(> % 0) #(<= % 12)) 2 4 6 8 10)
+   false    ((every-pred number? odd? #(> % 0) #(<= % 12)) 2 4 6 8 14)
+   ;; 4 preds, short-circuiting
+   false    ((every-pred number? odd? #(> % 0) #(<= % 12)) 1 :a)
+   false    ((every-pred number? odd? #(> % 0) #(<= % 12)) 1 3 :a)
+   false    ((every-pred number? odd? #(> % 0) #(<= % 12)) 1 3 5 :a)
+   false    ((every-pred number? odd? #(> % 0) #(<= % 12)) 1 3 5 7 :a)
+   false    ((every-pred number? odd? #(> % 0) #(<= % 12)) 1 :a 3 5 7)
+   ;; 5 preds
+   true     ((every-pred even? number? #(> % 0) #(<= % 12) #(zero? (rem % 2))))
+   true     ((every-pred even? number? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 2)
+   true     ((every-pred even? number? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 2 4)
+   true     ((every-pred even? number? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 2 4 6)
+   true     ((every-pred even? number? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 2 4 6 8)
+   true     ((every-pred even? number? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 2 4 6 8 10)
+   true     ((every-pred number? even? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 2 4 6 8 10 12)
+   false    ((every-pred number? odd? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 2)
+   false    ((every-pred number? odd? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 2 4)
+   false    ((every-pred number? odd? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 2 4 6)
+   false    ((every-pred number? odd? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 2 4 6 8)
+   false    ((every-pred number? odd? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 2 4 6 8 10)
+   false    ((every-pred number? odd? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 2 4 6 8 13)
+   ;; 5 preds, short-circuiting
+   false    ((every-pred number? odd? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 1 :a)
+   false    ((every-pred number? odd? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 1 3 :a)
+   false    ((every-pred number? odd? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 1 3 5 :a)
+   false    ((every-pred number? odd? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 1 3 5 7 :a)
+   false    ((every-pred number? odd? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 1 :a 3 5 7)
+   ;; truthiness
+   true     (reduce #(and % %2)
+                    (for [i (range 1 25)]
+                      (apply (apply every-pred (repeat i identity))
+                             (range i))))))
+
+; some-fn
+
+(deftest test-some-fn
+  (are [result] (identity result)
+   ;; 1 pred
+   (not ((some-fn even?)))
+   ((some-fn even?) 2)
+   ((some-fn even?) 2 4)
+   ((some-fn even?) 2 4 6)
+   ((some-fn even?) 2 4 6 8)
+   ((some-fn even?) 2 4 6 8 10)
+   (not ((some-fn odd?) 2))
+   (not ((some-fn odd?) 2 4))
+   (not ((some-fn odd?) 2 4 6))
+   (not ((some-fn odd?) 2 4 6 8))
+   (not ((some-fn odd?) 2 4 6 8 10))
+   ;; 2 preds
+   (not ((some-fn even? number?)))
+   ((some-fn even? number?) 2)
+   ((some-fn even? number?) 2 4)
+   ((some-fn even? number?) 2 4 6)
+   ((some-fn even? number?) 2 4 6 8)
+   ((some-fn even? number?) 2 4 6 8 10)
+   ((some-fn number? odd?) 2)
+   ((some-fn number? odd?) 2 4)
+   ((some-fn number? odd?) 2 4 6)
+   ((some-fn number? odd?) 2 4 6 8)
+   ((some-fn number? odd?) 2 4 6 8 10)
+   ;; 2 preds, short-circuiting
+   ((some-fn number? odd?) 1 :a)
+   ((some-fn number? odd?) 1 3 :a)
+   ((some-fn number? odd?) 1 3 5 :a)
+   ((some-fn number? odd?) 1 3 5 7 :a)
+   ((some-fn number? odd?) 1 :a 3 5 7)
+   ;; 3 preds
+   (not ((some-fn even? number? #(> % 0))))
+   ((some-fn even? number? #(> % 0)) 2)
+   ((some-fn even? number? #(> % 0)) 2 4)
+   ((some-fn even? number? #(> % 0)) 2 4 6)
+   ((some-fn even? number? #(> % 0)) 2 4 6 8)
+   ((some-fn even? number? #(> % 0)) 2 4 6 8 10)
+   ((some-fn number? even? #(> % 0)) 2 4 6 8 10 12)
+   ((some-fn number? odd? #(> % 0)) 2)
+   ((some-fn number? odd? #(> % 0)) 2 4)
+   ((some-fn number? odd? #(> % 0)) 2 4 6)
+   ((some-fn number? odd? #(> % 0)) 2 4 6 8)
+   ((some-fn number? odd? #(> % 0)) 2 4 6 8 10)
+   ((some-fn number? odd? #(> % 0)) 2 4 6 8 -10)
+   ;; 3 preds, short-circuiting
+   ((some-fn number? odd? #(> % 0)) 1 :a)
+   ((some-fn number? odd? #(> % 0)) 1 3 :a)
+   ((some-fn number? odd? #(> % 0)) 1 3 5 :a)
+   ((some-fn number? odd? #(> % 0)) 1 :a 3 5 7)
+   ;; 4 preds
+   (not ((some-fn even? number? #(> % 0) #(<= % 12))))
+   ((some-fn even? number? #(> % 0) #(<= % 12)) 2)
+   ((some-fn even? number? #(> % 0) #(<= % 12)) 2 4)
+   ((some-fn even? number? #(> % 0) #(<= % 12)) 2 4 6)
+   ((some-fn even? number? #(> % 0) #(<= % 12)) 2 4 6 8)
+   ((some-fn even? number? #(> % 0) #(<= % 12)) 2 4 6 8 10)
+   ((some-fn number? even? #(> % 0) #(<= % 12)) 2 4 6 8 10 12)
+   ((some-fn number? odd? #(> % 0) #(<= % 12)) 2)
+   ((some-fn number? odd? #(> % 0) #(<= % 12)) 2 4)
+   ((some-fn number? odd? #(> % 0) #(<= % 12)) 2 4 6)
+   ((some-fn number? odd? #(> % 0) #(<= % 12)) 2 4 6 8)
+   ((some-fn number? odd? #(> % 0) #(<= % 12)) 2 4 6 8 10)
+   ((some-fn number? odd? #(> % 0) #(<= % 12)) 2 4 6 8 14)
+   ;; 4 preds, short-circuiting
+   ((some-fn number? odd? #(> % 0) #(<= % 12)) 1 :a)
+   ((some-fn number? odd? #(> % 0) #(<= % 12)) 1 3 :a)
+   ((some-fn number? odd? #(> % 0) #(<= % 12)) 1 3 5 :a)
+   ((some-fn number? odd? #(> % 0) #(<= % 12)) 1 3 5 7 :a)
+   ((some-fn number? odd? #(> % 0) #(<= % 12)) 1 :a 3 5 7)
+   ;; 5 preds
+   (not ((some-fn even? number? #(> % 0) #(<= % 12) #(zero? (rem % 2)))))
+   ((some-fn even? number? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 2)
+   ((some-fn even? number? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 2 4)
+   ((some-fn even? number? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 2 4 6)
+   ((some-fn even? number? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 2 4 6 8)
+   ((some-fn even? number? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 2 4 6 8 10)
+   ((some-fn number? even? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 2 4 6 8 10 12)
+   ((some-fn number? odd? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 2)
+   ((some-fn number? odd? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 2 4)
+   ((some-fn number? odd? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 2 4 6)
+   ((some-fn number? odd? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 2 4 6 8)
+   ((some-fn number? odd? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 2 4 6 8 10)
+   ((some-fn number? odd? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 2 4 6 8 13)
+   ;; 5 preds, short-circuiting
+   ((some-fn number? odd? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 1 :a)
+   ((some-fn number? odd? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 1 3 :a)
+   ((some-fn number? odd? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 1 3 5 :a)
+   ((some-fn number? odd? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 1 3 5 7 :a)
+   ((some-fn number? odd? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 1 :a 3 5 7)
+   ;; truthiness
+   (reduce #(or % %2)
+           (conj
+             (vec
+               (for [i (range 1 25)]
+                 (apply (apply some-fn (repeat i (comp not boolean))) (range i))))
+                 true))))
+
 ; Printing
 ; pr prn print println newline
 ; pr-str prn-str print-str println-str [with-out-str (vars.clj)]