diff --git a/docs/language/core.rst b/docs/language/core.rst index 288d72a..76585e9 100644 --- a/docs/language/core.rst +++ b/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 `. => (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 diff --git a/hy/core/language.hy b/hy/core/language.hy index a1713bf..1007aba 100644 --- a/hy/core/language.hy +++ b/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 - drop-while empty? even? every? first filter flatten float? fraction gensym - group-by identity inc input instance? integer integer? integer-char? - interleave interpose islice iterable? iterate iterator? keyword keyword? - last list* macroexpand macroexpand-1 map merge-with multicombinations name - neg? none? nth numeric? odd? partition permutations pos? product range - read read-str remove repeat repeatedly rest reduce second some string - string? symbol? take take-nth take-while xor tee zero? zip zip-longest]) + comp complement compress cons cons? constantly count cycle dec distinct + disassemble drop drop-last drop-while empty? even? every? first filter + flatten float? fraction gensym group-by identity inc input instance? + integer integer? integer-char? interleave interpose islice iterable? + iterate iterator? keyword keyword? last list* macroexpand macroexpand-1 + map merge-with multicombinations name neg? none? nth numeric? odd? + partition permutations pos? product range read read-str remove repeat + repeatedly rest reduce second some string string? symbol? take take-nth + take-while xor tee zero? zip zip-longest]) diff --git a/tests/native_tests/core.hy b/tests/native_tests/core.hy index f9a540a..b279abd 100644 --- a/tests/native_tests/core.hy +++ b/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)))