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
This commit is contained in:
Tuukka Turto 2016-12-25 22:11:25 +02:00 committed by gilch
parent ca6fd66606
commit 71f30e845d
3 changed files with 124 additions and 8 deletions

View File

@ -54,6 +54,51 @@ Returns ``True`` if *x* is iterable and not a string.
False 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 cons
---- ----
@ -96,6 +141,30 @@ Checks whether *foo* is a :ref:`cons cell <hycons>`.
=> (cons? [1 2 3]) => (cons? [1 2 3])
False 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-fn:
dec dec

View File

@ -47,6 +47,24 @@
"Checks whether item is a collection" "Checks whether item is a collection"
(and (iterable? coll) (not (string? coll)))) (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] (defn cons [a b]
"Return a fresh cons cell with car = a and cdr = b" "Return a fresh cons cell with car = a and cdr = b"
(HyCons a b)) (HyCons a b))
@ -55,6 +73,11 @@
"Check whether c can be used as a cons object" "Check whether c can be used as a cons object"
(instance? HyCons c)) (instance? HyCons c))
(defn constantly [value]
"Create a function that always returns the same value"
(fn [&rest args &kwargs kwargs]
value))
(defn keyword? [k] (defn keyword? [k]
"Check whether k is a keyword" "Check whether k is a keyword"
(and (instance? (type :foo) k) (and (instance? (type :foo) k)
@ -456,11 +479,12 @@
(def *exports* (def *exports*
'[*map accumulate butlast calling-module-name chain coll? combinations '[*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])

View File

@ -626,3 +626,26 @@
(assert (in "keyword?" (names))) (assert (in "keyword?" (names)))
(assert (not-in "foo" (names))) (assert (not-in "foo" (names)))
(assert (not-in "hy" (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)))