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]))