From 2106a0e5d4beb6899d1fb49af655bc90a2c8850e Mon Sep 17 00:00:00 2001 From: agentultra Date: Thu, 28 Nov 2013 13:23:09 -0500 Subject: [PATCH 1/8] Add anaphoric versions of map, filter, and foreach Anaphoric macros reduce the need to specify a lambda by binding a special name in a form passed as a parameter to the macro. This allows you to write more concise code: (= (list (--filter (even? it) [1 2 3 4])) [2 4]) This patch just adds a few basic ones. Other forms that can be converted to anaphoric versions include reduce, remove, enumerate, etc. --- hy/core/macros.hy | 18 ++++++++++++++++++ tests/native_tests/core.hy | 21 +++++++++++++++++++++ 2 files changed, 39 insertions(+) diff --git a/hy/core/macros.hy b/hy/core/macros.hy index 17792f9..91c477d 100644 --- a/hy/core/macros.hy +++ b/hy/core/macros.hy @@ -3,6 +3,7 @@ ;; Copyright (c) 2013 Nicolas Dandrimont ;; Copyright (c) 2013 Paul Tagliamonte ;; Copyright (c) 2013 Konrad Hinsen +;; Copyright (c) 2013 James King ;; ;; Permission is hereby granted, free of charge, to any person obtaining a ;; copy of this software and associated documentation files (the "Software"), @@ -116,3 +117,20 @@ ;; TODO: this needs some gensym love `(foreach [_hy_yield_from_x ~iterable] (yield _hy_yield_from_x))) + + +(defmacro --each [lst &rest body] + `(foreach [it ~list] ~@body)) + + +(defmacro --map [form lst] + `(let [[f (lambda [it] ~form)]] + (foreach [v ~lst] + (yield (f v))))) + + +(defmacro --filter [form lst] + `(let [[pred (lambda [it] ~form)]] + (foreach [val ~lst] + (if (pred val) + (yield val))))) diff --git a/tests/native_tests/core.hy b/tests/native_tests/core.hy index 6e81f39..cde0cb6 100644 --- a/tests/native_tests/core.hy +++ b/tests/native_tests/core.hy @@ -1,5 +1,6 @@ ;; Copyright (c) 2013 Paul Tagliamonte ;; Copyright (c) 2013 Bob Tolbert +;; Copyright (c) 2013 James King ;; Permission is hereby granted, free of charge, to any person obtaining a ;; copy of this software and associated documentation files (the "Software"), @@ -391,3 +392,23 @@ (assert-equal res [None None]) (setv res (list (take-while (fn [x] (not (none? x))) [1 2 3 4 None 5 6 None 7]))) (assert-equal res [1 2 3 4])) + +(defn test-anaphoric-each [] + "NATIVE: testing anaphoric each" + (setv res []) + (--each [1 2 3 4] (.append res it)) + (assert-equal res [1 2 3 4])) + +(defn test-anaphoric-map [] + "NATIVE: testing anaphoric map" + (assert-equal (list (--map (* it 3) [1 2 3])) + [3 6 9]) + (assert-equal (list (--map (* it 3) [])) + [])) + +(defn test-anaphoric-filter [] + "NATIVE: testing anaphoric filter" + (assert-equal (list (--filter (> it 2) [1 2 3 4])) + [3 4]) + (assert-equal (list (--filter (even? it) [1 2 3 4])) + [2 4])) From 8e44cc3d9a4600eb6e256e14e4c50a22dd0b0d50 Mon Sep 17 00:00:00 2001 From: agentultra Date: Thu, 28 Nov 2013 16:15:23 -0500 Subject: [PATCH 2/8] Add --each-while and --map-when A couple of more macros: hy> (--each-while [1 2 3 4 5] (< it 3) (print it)) 1 2 3 hy> ```--each-while``` continues to evaluate the body form while the predicate form is true for each element in the list. ```--map-when``` uses a predicate form to determine when to apply the map form upon the element in the list: hy> (list (--map-when (even? it) (* it 3) [1 2 3 4])) [1, 6, 3, 12] --- hy/core/macros.hy | 17 +++++++++++++++++ tests/native_tests/core.hy | 13 +++++++++++++ 2 files changed, 30 insertions(+) diff --git a/hy/core/macros.hy b/hy/core/macros.hy index 91c477d..a3261ab 100644 --- a/hy/core/macros.hy +++ b/hy/core/macros.hy @@ -123,12 +123,29 @@ `(foreach [it ~list] ~@body)) +(defmacro --each-while [lst pred &rest body] + `(let [[p (lambda [it] ~pred)]] + (foreach [it ~lst] + (if (p it) + ~@body + (break))))) + + (defmacro --map [form lst] `(let [[f (lambda [it] ~form)]] (foreach [v ~lst] (yield (f v))))) +(defmacro --map-when [pred rep lst] + `(let [[p (lambda [it] ~pred)] + [f (lambda [it] ~rep)]] + (foreach [v ~lst] + (if (p v) + (yield (r v)) + (yield v))))) + + (defmacro --filter [form lst] `(let [[pred (lambda [it] ~form)]] (foreach [val ~lst] diff --git a/tests/native_tests/core.hy b/tests/native_tests/core.hy index cde0cb6..e14dc0f 100644 --- a/tests/native_tests/core.hy +++ b/tests/native_tests/core.hy @@ -399,6 +399,13 @@ (--each [1 2 3 4] (.append res it)) (assert-equal res [1 2 3 4])) + +(defn test-anaphoric-each-while [] + "NATIVE: testing anaphoric each-while" + (setv res []) + (--each-while [2 2 4 3 4 5 6] (even? it) (.append res it)) + (assert-equal res [2 2 4])) + (defn test-anaphoric-map [] "NATIVE: testing anaphoric map" (assert-equal (list (--map (* it 3) [1 2 3])) @@ -406,6 +413,12 @@ (assert-equal (list (--map (* it 3) [])) [])) + +(defn test-anaphoric-map-when [] + "NATIVE: testing anaphoric map-when" + (assert-equal (list (--map-when (even? it) (* it 2) [1 2 3 4])) + [1 4 3 8])) + (defn test-anaphoric-filter [] "NATIVE: testing anaphoric filter" (assert-equal (list (--filter (> it 2) [1 2 3 4])) From 20df6a5532cf3a38e4ece8abae7e81d2258a8f94 Mon Sep 17 00:00:00 2001 From: agentultra Date: Thu, 28 Nov 2013 16:45:07 -0500 Subject: [PATCH 3/8] Make --map-when accept a predicate function instead of a form This makes it look a little cleaner: (list (--map-when odd? (* it 3) [1 2 3 4 5])) --- hy/core/macros.hy | 13 ++++++------- tests/native_tests/core.hy | 3 +-- 2 files changed, 7 insertions(+), 9 deletions(-) diff --git a/hy/core/macros.hy b/hy/core/macros.hy index a3261ab..5ccfba7 100644 --- a/hy/core/macros.hy +++ b/hy/core/macros.hy @@ -137,13 +137,12 @@ (yield (f v))))) -(defmacro --map-when [pred rep lst] - `(let [[p (lambda [it] ~pred)] - [f (lambda [it] ~rep)]] - (foreach [v ~lst] - (if (p v) - (yield (r v)) - (yield v))))) +(defmacro --map-when [predfn rep lst] + `(let [[f (lambda [it] ~rep)]] + (foreach [it ~lst] + (if (~pred it) + (yield (f it)) + (yield it))))) (defmacro --filter [form lst] diff --git a/tests/native_tests/core.hy b/tests/native_tests/core.hy index e14dc0f..4c2ebaa 100644 --- a/tests/native_tests/core.hy +++ b/tests/native_tests/core.hy @@ -413,10 +413,9 @@ (assert-equal (list (--map (* it 3) [])) [])) - (defn test-anaphoric-map-when [] "NATIVE: testing anaphoric map-when" - (assert-equal (list (--map-when (even? it) (* it 2) [1 2 3 4])) + (assert-equal (list (--map-when even? (* it 2) [1 2 3 4])) [1 4 3 8])) (defn test-anaphoric-filter [] From 179017b9bdb2c6049922d6a08ca3a9d929794388 Mon Sep 17 00:00:00 2001 From: agentultra Date: Thu, 28 Nov 2013 23:53:02 -0500 Subject: [PATCH 4/8] Move anaphoric macros to contrib module --- hy/contrib/anaphoric.hy | 56 ++++++++++++++++++++++ hy/core/macros.hy | 33 ------------- tests/native_tests/contrib/anaphoric.hy | 63 +++++++++++++++++++++++++ tests/native_tests/core.hy | 33 ------------- 4 files changed, 119 insertions(+), 66 deletions(-) create mode 100644 hy/contrib/anaphoric.hy create mode 100644 tests/native_tests/contrib/anaphoric.hy diff --git a/hy/contrib/anaphoric.hy b/hy/contrib/anaphoric.hy new file mode 100644 index 0000000..bd8f3c1 --- /dev/null +++ b/hy/contrib/anaphoric.hy @@ -0,0 +1,56 @@ +;;; Hy anaphoric macros +;; +;; Copyright (c) 2013 James King +;; +;; Permission is hereby granted, free of charge, to any person obtaining a +;; copy of this software and associated documentation files (the "Software"), +;; to deal in the Software without restriction, including without limitation +;; the rights to use, copy, modify, merge, publish, distribute, sublicense, +;; and/or sell copies of the Software, and to permit persons to whom the +;; Software is furnished to do so, subject to the following conditions: +;; +;; The above copyright notice and this permission notice shall be included in +;; all copies or substantial portions of the Software. +;; +;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL +;; THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING +;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER +;; DEALINGS IN THE SOFTWARE. +;; +;;; These macros make writing functional programs more concise + + +(defmacro ap-each [lst &rest body] + `(foreach [it ~list] ~@body)) + + +(defmacro ap-each-while [lst pred &rest body] + `(let [[p (lambda [it] ~pred)]] + (foreach [it ~lst] + (if (p it) + ~@body + (break))))) + + +(defmacro ap-map [form lst] + `(let [[f (lambda [it] ~form)]] + (foreach [v ~lst] + (yield (f v))))) + + +(defmacro ap-map-when [predfn rep lst] + `(let [[f (lambda [it] ~rep)]] + (foreach [it ~lst] + (if (~pred it) + (yield (f it)) + (yield it))))) + + +(defmacro ap-filter [form lst] + `(let [[pred (lambda [it] ~form)]] + (foreach [val ~lst] + (if (pred val) + (yield val))))) diff --git a/hy/core/macros.hy b/hy/core/macros.hy index 5ccfba7..0d08946 100644 --- a/hy/core/macros.hy +++ b/hy/core/macros.hy @@ -117,36 +117,3 @@ ;; TODO: this needs some gensym love `(foreach [_hy_yield_from_x ~iterable] (yield _hy_yield_from_x))) - - -(defmacro --each [lst &rest body] - `(foreach [it ~list] ~@body)) - - -(defmacro --each-while [lst pred &rest body] - `(let [[p (lambda [it] ~pred)]] - (foreach [it ~lst] - (if (p it) - ~@body - (break))))) - - -(defmacro --map [form lst] - `(let [[f (lambda [it] ~form)]] - (foreach [v ~lst] - (yield (f v))))) - - -(defmacro --map-when [predfn rep lst] - `(let [[f (lambda [it] ~rep)]] - (foreach [it ~lst] - (if (~pred it) - (yield (f it)) - (yield it))))) - - -(defmacro --filter [form lst] - `(let [[pred (lambda [it] ~form)]] - (foreach [val ~lst] - (if (pred val) - (yield val))))) diff --git a/tests/native_tests/contrib/anaphoric.hy b/tests/native_tests/contrib/anaphoric.hy new file mode 100644 index 0000000..7fb08f4 --- /dev/null +++ b/tests/native_tests/contrib/anaphoric.hy @@ -0,0 +1,63 @@ +;; Copyright (c) 2013 James King + +;; Permission is hereby granted, free of charge, to any person obtaining a +;; copy of this software and associated documentation files (the "Software"), +;; to deal in the Software without restriction, including without limitation +;; the rights to use, copy, modify, merge, publish, distribute, sublicense, +;; and/or sell copies of the Software, and to permit persons to whom the +;; Software is furnished to do so, subject to the following conditions: + +;; The above copyright notice and this permission notice shall be included in +;; all copies or substantial portions of the Software. + +;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL +;; THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING +;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER +;; DEALINGS IN THE SOFTWARE. + +;;;; some simple helpers + +(require hy.contrib.anaphoric) + +(defn assert-true [x] + (assert (= True x))) + +(defn assert-false [x] + (assert (= False x))) + +(defn assert-equal [x y] + (assert (= x y))) + +(defn test-ap-each [] + "NATIVE: testing anaphoric each" + (setv res []) + (ap-each [1 2 3 4] (.append res it)) + (assert-equal res [1 2 3 4])) + +(defn test-ap-each-while [] + "NATIVE: testing anaphoric each-while" + (setv res []) + (ap-each-while [2 2 4 3 4 5 6] (even? it) (.append res it)) + (assert-equal res [2 2 4])) + +(defn test-ap-map [] + "NATIVE: testing anaphoric map" + (assert-equal (list (ap-map (* it 3) [1 2 3])) + [3 6 9]) + (assert-equal (list (ap-map (* it 3) [])) + [])) + +(defn test-ap-map-when [] + "NATIVE: testing anaphoric map-when" + (assert-equal (list (ap-map-when even? (* it 2) [1 2 3 4])) + [1 4 3 8])) + +(defn test-ap-filter [] + "NATIVE: testing anaphoric filter" + (assert-equal (list (ap-filter (> it 2) [1 2 3 4])) + [3 4]) + (assert-equal (list (ap-filter (even? it) [1 2 3 4])) + [2 4])) diff --git a/tests/native_tests/core.hy b/tests/native_tests/core.hy index 4c2ebaa..6e81f39 100644 --- a/tests/native_tests/core.hy +++ b/tests/native_tests/core.hy @@ -1,6 +1,5 @@ ;; Copyright (c) 2013 Paul Tagliamonte ;; Copyright (c) 2013 Bob Tolbert -;; Copyright (c) 2013 James King ;; Permission is hereby granted, free of charge, to any person obtaining a ;; copy of this software and associated documentation files (the "Software"), @@ -392,35 +391,3 @@ (assert-equal res [None None]) (setv res (list (take-while (fn [x] (not (none? x))) [1 2 3 4 None 5 6 None 7]))) (assert-equal res [1 2 3 4])) - -(defn test-anaphoric-each [] - "NATIVE: testing anaphoric each" - (setv res []) - (--each [1 2 3 4] (.append res it)) - (assert-equal res [1 2 3 4])) - - -(defn test-anaphoric-each-while [] - "NATIVE: testing anaphoric each-while" - (setv res []) - (--each-while [2 2 4 3 4 5 6] (even? it) (.append res it)) - (assert-equal res [2 2 4])) - -(defn test-anaphoric-map [] - "NATIVE: testing anaphoric map" - (assert-equal (list (--map (* it 3) [1 2 3])) - [3 6 9]) - (assert-equal (list (--map (* it 3) [])) - [])) - -(defn test-anaphoric-map-when [] - "NATIVE: testing anaphoric map-when" - (assert-equal (list (--map-when even? (* it 2) [1 2 3 4])) - [1 4 3 8])) - -(defn test-anaphoric-filter [] - "NATIVE: testing anaphoric filter" - (assert-equal (list (--filter (> it 2) [1 2 3 4])) - [3 4]) - (assert-equal (list (--filter (even? it) [1 2 3 4])) - [2 4])) From cb6889314a81f3b78ea4085b896ea432382aebee Mon Sep 17 00:00:00 2001 From: agentultra Date: Fri, 29 Nov 2013 19:59:20 -0500 Subject: [PATCH 5/8] Add documentation and doc strings --- docs/contrib/anaphoirc.rst | 96 ++++++++++++++++++++++++++++++++++++++ docs/contrib/index.rst | 10 ++++ docs/index.rst | 1 + hy/contrib/anaphoric.hy | 11 ++++- 4 files changed, 116 insertions(+), 2 deletions(-) create mode 100644 docs/contrib/anaphoirc.rst create mode 100644 docs/contrib/index.rst diff --git a/docs/contrib/anaphoirc.rst b/docs/contrib/anaphoirc.rst new file mode 100644 index 0000000..0a487c2 --- /dev/null +++ b/docs/contrib/anaphoirc.rst @@ -0,0 +1,96 @@ +==================== +Anaphoric Macros +==================== + +The anaphoric macros module makes functional programming in Hy very +concise and easy to read. + + An anaphoric macro is a type of programming macro that + deliberately captures some form supplied to the macro which may be + referred to by an anaphor (an expression referring to another). + + -- Wikipedia (http://en.wikipedia.org/wiki/Anaphoric_macro) + +Macros +====== + +.. _ap-each: + +ap-each +------- + +Usage: ``(ap-each [1 2 3 4 5] (print it))`` + +Evaluate the form for each element in the list for side-effects. + + +.. _ap-each-while: + +ap-each-while +============= + +Usage: ``(ap-each-while list pred body)`` + +Evaluate the form for each element where the predicate form returns +True. + +.. code-block:: clojure + + => (ap-each-while [1 2 3 4 5 6] (< it 4) (print it)) + 1 + 2 + 3 + +.. _ap-map: + +ap-map +====== + +Usage: ``(ap-map form list)`` + +The anaphoric form of map works just like regular map except that +instead of a function object it takes a Hy form. The special name, +``it`` is bound to the current object from the list in the iteration. + +.. code-block:: clojure + + => (list (ap-map (* it 2) [1 2 3])) + [2, 4, 6] + + +.. _ap-map-when: + +ap-map-when +=========== + +Usage: ``(ap-map-when predfn rep list)`` + +Evaluate a mapping over the list using a predicate function to +determin when to apply the form. + +.. code-block:: clojure + + => (list (ap-map-when odd? (* it 2) [1 2 3 4])) + [2, 2, 6, 4] + + => (list (ap-map-when even? (* it 2) [1 2 3 4])) + [1, 4, 3, 8] + + +.. _ap-filter: + +ap-filter +========= + +Usage: ``(ap-filter form list)`` + +As with ``ap-map`` we take a special form instead of a function to +filter the elements of the list. The special name ``it`` is bound to +the current element in the iteration. + +.. code-block:: clojure + + => (list (ap-filter (> (* it 2) 6) [1 2 3 4 5])) + [4, 5] + + diff --git a/docs/contrib/index.rst b/docs/contrib/index.rst new file mode 100644 index 0000000..80b7697 --- /dev/null +++ b/docs/contrib/index.rst @@ -0,0 +1,10 @@ + +Contrib Modules Index +===================== + +Contents: + +.. toctree:: + :maxdepth: 3 + + anaphoric diff --git a/docs/index.rst b/docs/index.rst index 299c59e..102929a 100644 --- a/docs/index.rst +++ b/docs/index.rst @@ -49,3 +49,4 @@ Contents: tutorial hacking language/index + contrib/index diff --git a/hy/contrib/anaphoric.hy b/hy/contrib/anaphoric.hy index bd8f3c1..13825b5 100644 --- a/hy/contrib/anaphoric.hy +++ b/hy/contrib/anaphoric.hy @@ -24,11 +24,14 @@ (defmacro ap-each [lst &rest body] + "Evaluate the body form for each element in the list." `(foreach [it ~list] ~@body)) -(defmacro ap-each-while [lst pred &rest body] - `(let [[p (lambda [it] ~pred)]] +(defmacro ap-each-while [lst form &rest body] + "Evalutate the body form for each element in the list while the + predicate form evaluates to True." + `(let [[p (lambda [it] ~form)]] (foreach [it ~lst] (if (p it) ~@body @@ -36,12 +39,15 @@ (defmacro ap-map [form lst] + "Yield elements evaluated in the form for each element in the list." `(let [[f (lambda [it] ~form)]] (foreach [v ~lst] (yield (f v))))) (defmacro ap-map-when [predfn rep lst] + "Yield elements evaluated for each element in the list when the + predicate function returns True." `(let [[f (lambda [it] ~rep)]] (foreach [it ~lst] (if (~pred it) @@ -50,6 +56,7 @@ (defmacro ap-filter [form lst] + "Yield elements returned when the predicate form evaluates to True." `(let [[pred (lambda [it] ~form)]] (foreach [val ~lst] (if (pred val) From 77db7790191ef927d4fd560496a290bf47bcbd64 Mon Sep 17 00:00:00 2001 From: agentultra Date: Sat, 30 Nov 2013 10:29:41 -0500 Subject: [PATCH 6/8] Fix typo in ap-each --- hy/contrib/anaphoric.hy | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/hy/contrib/anaphoric.hy b/hy/contrib/anaphoric.hy index 13825b5..c9a0fef 100644 --- a/hy/contrib/anaphoric.hy +++ b/hy/contrib/anaphoric.hy @@ -25,7 +25,7 @@ (defmacro ap-each [lst &rest body] "Evaluate the body form for each element in the list." - `(foreach [it ~list] ~@body)) + `(foreach [it ~lst] ~@body)) (defmacro ap-each-while [lst form &rest body] From 5753fc0789391bcdbbfc09970044c4539e23e895 Mon Sep 17 00:00:00 2001 From: agentultra Date: Sat, 30 Nov 2013 10:30:42 -0500 Subject: [PATCH 7/8] Fix typo in ap-map-when --- hy/contrib/anaphoric.hy | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/hy/contrib/anaphoric.hy b/hy/contrib/anaphoric.hy index c9a0fef..d0a163a 100644 --- a/hy/contrib/anaphoric.hy +++ b/hy/contrib/anaphoric.hy @@ -50,7 +50,7 @@ predicate function returns True." `(let [[f (lambda [it] ~rep)]] (foreach [it ~lst] - (if (~pred it) + (if (~predfn it) (yield (f it)) (yield it))))) From 0b6d047239346278db3264d50dcb0acf835bb09f Mon Sep 17 00:00:00 2001 From: J Kenneth King Date: Sat, 30 Nov 2013 10:35:57 -0500 Subject: [PATCH 8/8] Remove james@agentultra.com from copyright in core/macros.py --- hy/core/macros.hy | 1 - 1 file changed, 1 deletion(-) diff --git a/hy/core/macros.hy b/hy/core/macros.hy index 0d08946..17792f9 100644 --- a/hy/core/macros.hy +++ b/hy/core/macros.hy @@ -3,7 +3,6 @@ ;; Copyright (c) 2013 Nicolas Dandrimont ;; Copyright (c) 2013 Paul Tagliamonte ;; Copyright (c) 2013 Konrad Hinsen -;; Copyright (c) 2013 James King ;; ;; Permission is hereby granted, free of charge, to any person obtaining a ;; copy of this software and associated documentation files (the "Software"),