Add comp, constantly and complement (#1179)

* Add comp, constantly and complement

relates #1176

* Fix composition order in comp

* comp without parameters returns identity

* Doc edits for comp, complement, constantly

* Test that `(comp)` returns `identity` exactly

* Simplify the `reduce` call in `comp`

* updated version of comp

docs/language/core.rst

@@ -54,6 +54,51 @@ Returns ``True`` if *x* is iterable and not a string.
    False
 
 
+.. _comp:
+
+comp
+----
+
+Usage: ``(comp f g)``
+
+Compose zero or more functions into a new function. The new function will
+chain the given functions together, so ``((comp g f) x)`` is equivalent to
+``(g (f x))``. Called without arguments, ``comp`` returns ``identity``.
+
+.. code-block:: hy
+
+   => (def example (comp str +))
+   => (example 1 2 3)
+   "6"
+
+   => (def simple (comp))
+   => (simple "hello")
+   "hello"
+
+
+.. _complement:
+
+complement
+----------
+
+.. versionadded:: 0.12.0
+
+Usage: ``(complement f)``
+
+Returns a new function that returns the same thing as ``f``, but logically
+inverted. So, ``((complement f) x)`` is equivalent to ``(not (f x))``.
+
+.. code-block:: hy
+
+   => (def inverse (complement identity))
+   => (inverse True)
+   False
+   => (inverse 1)
+   False
+   => (inverse False)
+   True
+
+
 cons
 ----
 
@@ -96,6 +141,30 @@ Checks whether *foo* is a :ref:`cons cell <hycons>`.
    => (cons? [1 2 3])
    False
 
+
+.. _constantly:
+
+constantly
+----------
+
+.. versionadded:: 0.12.0
+
+Usage ``(constantly 42)``
+
+Create a new function that always returns the given value, regardless of
+the arguments given to it.
+
+.. code-block:: hy
+
+   => (def answer (constantly 42))
+   => (answer)
+   42
+   => (answer 1 2 3)
+   42
+   => (answer 1 :foo 2)
+   42
+
+
 .. _dec-fn:
 
 dec

hy/core/language.hy

@@ -47,6 +47,24 @@
   "Checks whether item is a collection"
   (and (iterable? coll) (not (string? coll))))
 
+(defn comp [&rest fs]
+  "Function composition"
+  (if (not fs) identity
+      (= 1 (len fs)) (first fs)
+      (do (setv rfs (reversed fs)
+                first-f (next rfs)
+                fs (tuple rfs))
+          (fn [&rest args &kwargs kwargs]
+            (setv res (apply first-f args kwargs))
+            (for* [f fs]
+              (setv res (f res)))
+            res))))
+
+(defn complement [f]
+  "Create a function that reverses truth value of another function"
+  (fn [&rest args &kwargs kwargs]
+    (not (apply f args kwargs))))
+
 (defn cons [a b]
   "Return a fresh cons cell with car = a and cdr = b"
   (HyCons a b))
@@ -55,6 +73,11 @@
   "Check whether c can be used as a cons object"
   (instance? HyCons c))
 
+(defn constantly [value]
+  "Create a function that always returns the same value"
+  (fn [&rest args &kwargs kwargs]
+    value))
+
 (defn keyword? [k]
   "Check whether k is a keyword"
   (and (instance? (type :foo) k)
@@ -456,11 +479,12 @@
 
 (def *exports*
   '[*map accumulate butlast calling-module-name chain coll? combinations
-    compress cons cons? count cycle dec distinct disassemble drop drop-last
+    comp complement compress cons cons? constantly count cycle dec distinct
-    drop-while empty? even? every? first filter flatten float? fraction gensym
+    disassemble drop drop-last drop-while empty? even? every? first filter
-    group-by identity inc input instance? integer integer? integer-char?
+    flatten float? fraction gensym group-by identity inc input instance?
-    interleave interpose islice iterable? iterate iterator? keyword keyword?
+    integer integer? integer-char? interleave interpose islice iterable? 
-    last list* macroexpand macroexpand-1 map merge-with multicombinations name
+    iterate iterator? keyword keyword? last list* macroexpand macroexpand-1 
-    neg? none? nth numeric? odd? partition permutations pos? product range
+    map merge-with multicombinations name neg? none? nth numeric? odd? 
-    read read-str remove repeat repeatedly rest reduce second some string
+    partition permutations pos? product range read read-str remove repeat 
-    string? symbol? take take-nth take-while xor tee zero? zip zip-longest])
+    repeatedly rest reduce second some string string? symbol? take take-nth 
+    take-while xor tee zero? zip zip-longest])

tests/native_tests/core.hy

@@ -626,3 +626,26 @@
   (assert (in "keyword?" (names)))
   (assert (not-in "foo" (names)))
   (assert (not-in "hy" (names))))
+
+(defn test-complement []
+  "NATIVE: test complement"
+  (def helper (complement identity))
+  
+  (assert-true (helper False))
+  (assert-false (helper True)))
+
+(defn test-constantly []
+  "NATIVE: test constantly"
+  (def helper (constantly 42))
+
+  (assert-true (= (helper) 42))
+  (assert-true (= (helper 1 2 3) 42))
+  (assert-true (= (helper 1 2 :foo 3) 42)))
+
+(defn test-comp []
+  "NATIVE: test comp"
+  (assert-true ((comp odd? inc second) [1 2 3 4 5]))
+  (assert-true (= 1 ((comp first) [1 2 3])))
+  (assert-true ((comp even? inc +) 1 2 3 4 5))
+  (assert-true (= 5 ((comp) 5)))
+  (assert (is (comp) identity)))