From f1de9050ead9524e41f8c6e4f9e7a16f0f41660f Mon Sep 17 00:00:00 2001 From: Joseph Egan Date: Sat, 28 Mar 2020 22:48:16 +0000 Subject: [PATCH] Reduce scope of symbol replacement for anaphoric macros --- NEWS.rst | 5 ++ docs/extra/anaphoric.rst | 8 ++- hy/extra/anaphoric.hy | 72 +++++++++++-------- tests/native_tests/extra/anaphoric.hy | 100 +++++++++++++++++++++++--- 4 files changed, 141 insertions(+), 44 deletions(-) diff --git a/NEWS.rst b/NEWS.rst index 8bff566..b84345e 100644 --- a/NEWS.rst +++ b/NEWS.rst @@ -8,6 +8,11 @@ Other Breaking Changes * `parse-args` is no longer implemented with `eval`; so e.g. you should now say `:type int` instead of `:type 'int`. +Bug Fixes +------------------------------ +* Improved support for nesting anaphoric macros by only applying + symbol replacement where absolutely necessary. + 0.18.0 ============================== diff --git a/docs/extra/anaphoric.rst b/docs/extra/anaphoric.rst index b763a8b..7b8fb5c 100644 --- a/docs/extra/anaphoric.rst +++ b/docs/extra/anaphoric.rst @@ -19,9 +19,11 @@ To use these macros you need to require the ``hy.extra.anaphoric`` module like s These macros are implemented by replacing any use of the designated anaphoric symbols (``it``, in most cases) with a gensym. Consequently, -it's unwise to nest these macros, or to use an affected symbol as -something other than a variable name, as in ``(print "My favorite -Stephen King book is" 'it)``. +it's unwise to nest these macros where symbol replacement is happening. +Symbol replacement typically takes place in ``body`` or ``form`` +parameters, where the output of the expression may be returned. It is also +recommended to avoid using an affected symbol as something other than a +variable name, as in ``(print "My favorite Stephen King book is" 'it)``. .. _ap-if: diff --git a/hy/extra/anaphoric.hy b/hy/extra/anaphoric.hy index 6a7ec7a..d116244 100644 --- a/hy/extra/anaphoric.hy +++ b/hy/extra/anaphoric.hy @@ -3,49 +3,62 @@ ;; This file is part of Hy, which is free software licensed under the Expat ;; license. See the LICENSE. +;;; Macro to help write anaphoric macros + +(defmacro rit [&rest body] + """Supply `it` as a gensym and R as a function to replace `it` with the + given gensym throughout expressions.""" + `(do + (setv it (gensym)) + (defn R [form] + "Replace `it` with a gensym throughout `form`." + (recur-sym-replace {'it it} form)) + ~@body)) + + ;;; These macros make writing functional programs more concise (defmacro ap-if [test-form then-form &optional else-form] (rit `(do - (setv it ~test-form) - (if it ~then-form ~else-form)))) + (setv ~it ~test-form) + (if ~it ~(R then-form) ~(R else-form))))) (defmacro ap-each [xs &rest body] - (rit `(for [it ~xs] ~@body))) + (rit `(for [~it ~xs] ~@(R body)))) (defmacro ap-each-while [xs form &rest body] - (rit `(for [it ~xs] - (unless ~form + (rit `(for [~it ~xs] + (unless ~(R form) (break)) - ~@body))) + ~@(R body)))) (defmacro ap-map [form xs] - (rit `(gfor it ~xs ~form))) + (rit `(gfor ~it ~xs ~(R form)))) (defmacro ap-map-when [predfn rep xs] - (rit `(gfor it ~xs (if (~predfn it) ~rep it)))) + (rit `(gfor ~it ~xs (if (~predfn ~it) ~(R rep) ~it)))) (defmacro ap-filter [form xs] - (rit `(gfor it ~xs :if ~form it))) + (rit `(gfor ~it ~xs :if ~(R form) ~it))) (defmacro ap-reject [form xs] - (rit `(gfor it ~xs :if (not ~form) it))) + (rit `(gfor ~it ~xs :if (not ~(R form)) ~it))) (defmacro ap-dotimes [n &rest body] - (rit `(for [it (range ~n)] - ~@body))) + (rit `(for [~it (range ~n)] + ~@(R body)))) (defmacro ap-first [form xs] (rit `(next - (gfor it ~xs :if ~form it) + (gfor ~it ~xs :if ~(R form) ~it) None))) @@ -53,21 +66,25 @@ (setv x (gensym)) (rit `(do (setv ~x None) - (for [it ~xs :if ~form] - (setv ~x it)) + (for [~it ~xs :if ~(R form)] + (setv ~x ~it)) ~x))) - (defmacro! ap-reduce [form o!xs &optional [initial-value None]] - (recur-sym-replace {'it (gensym) 'acc (gensym)} `(do - (setv acc ~(if (none? initial-value) - `(do - (setv ~g!xs (iter ~g!xs)) - (next ~g!xs)) - initial-value)) - (for [it ~g!xs] - (setv acc ~form)) - acc))) + (setv + it (gensym) + acc (gensym)) + (defn R [form] + (recur-sym-replace {'it it 'acc acc} form)) + `(do + (setv ~acc ~(if (none? initial-value) + `(do + (setv ~g!xs (iter ~g!xs)) + (next ~g!xs)) + initial-value)) + (for [~it ~g!xs] + (setv ~acc ~(R form))) + ~acc)) (deftag % [expr] @@ -106,8 +123,3 @@ ((type form) (gfor x form (recur-sym-replace d x)))] [True form])) - - -(defn rit [form] - "Replace `it` with a gensym throughout `form`." - (recur-sym-replace {'it (gensym)} form)) diff --git a/tests/native_tests/extra/anaphoric.hy b/tests/native_tests/extra/anaphoric.hy index 5dd9da9..e9b8e76 100644 --- a/tests/native_tests/extra/anaphoric.hy +++ b/tests/native_tests/extra/anaphoric.hy @@ -13,17 +13,40 @@ (setv it "orig") (setv out (ap-if (+ 1 1) (+ it 1) (+ it 10))) (assert (= out 3)) - (assert (= it "orig"))) + (assert (= it "orig")) + + (ap-if + (->> [1 2 3 4 5] + (ap-filter (= (% it 2) 0)) + (list)) + (assert (= it [2 4])))) + (defn test-ap-each [] (setv res []) (assert (is (ap-each [1 2 3 4] (.append res it)) None)) - (assert (= res [1 2 3 4]))) + (assert (= res [1 2 3 4])) + + (setv res []) + (ap-each + (->> [1 2 3 4] + (ap-map (+ 1 it)) + (list)) + (.append res it)) + (assert (= res [2 3 4 5]))) (defn test-ap-each-while [] (setv res []) (ap-each-while [2 2 4 3 4 5 6] (even? it) (.append res it)) - (assert (= res [2 2 4]))) + (assert (= res [2 2 4])) + + (setv res []) + (ap-each-while + (->> [2 2 4 3 4 5 6] + (ap-map (+ 1 it)) + (list)) + (odd? it) (.append res it)) + (assert (= res [3 3 5]))) (defn test-ap-map [] (assert (= (list (ap-map (* it 3) [1 2 3])) @@ -31,23 +54,51 @@ (assert (= (list (ap-map (* it 3) [])) [])) (assert (= (do (setv v 1 f 1) (list (ap-map (it v f) [(fn [a b] (+ a b))]))) - [2]))) + [2])) + + (assert (= + (->> [1 2 3] + (ap-filter (even? it)) + (ap-map (* 3 it)) + (list)) + [6]))) (defn test-ap-map-when [] (assert (= (list (ap-map-when even? (* it 2) [1 2 3 4])) - [1 4 3 8]))) + [1 4 3 8])) + + (assert (= + (->> [1 2 3 4] + (ap-map (+ 1 it)) + (ap-map-when even? (* 2 it)) + (list)) + [4 3 8 5]))) (defn test-ap-filter [] (assert (= (list (ap-filter (> it 2) [1 2 3 4])) [3 4])) (assert (= (list (ap-filter (even? it) [1 2 3 4])) - [2 4]))) + [2 4])) + + (assert (= + (->> [1 2 3 4] + (ap-map (+ 3 it)) + (ap-filter (even? it)) + (list)) + [4 6]))) (defn test-ap-reject [] (assert (= (list (ap-reject (> it 2) [1 2 3 4])) [1 2])) (assert (= (list (ap-reject (even? it) [1 2 3 4])) - [1 3]))) + [1 3])) + + (assert (= + (->> [1 2 3 4] + (ap-map (+ 3 it)) + (ap-reject (even? it)) + (list)) + [5 7]))) (defn test-ap-dotimes [] (assert (= (do (setv n []) (ap-dotimes 3 (.append n 3)) n) @@ -59,17 +110,38 @@ (setv n 5) (setv x "") (ap-dotimes n (+= x ".")) - (assert (= x "....."))) + (assert (= x ".....")) + + (assert (= + (do + (setv n []) + (ap-dotimes + (ap-first (odd? it) [2 4 5 6 3 8]) + (.append n it)) + n) + [0 1 2 3 4]))) (defn test-ap-first [] (assert (= (ap-first (> it 5) (range 10)) 6)) (assert (= (ap-first (even? it) [1 2 3 4]) 2)) - (assert (= (ap-first (> it 10) (range 10)) None))) + (assert (= (ap-first (> it 10) (range 10)) None)) + + (assert (= + (->> [1 2 3 4] + (ap-map (+ 4 it)) + (ap-first (even? it))) + 6))) (defn test-ap-last [] (assert (= (ap-last (> it 5) (range 10)) 9)) (assert (= (ap-last (even? it) [1 2 3 4]) 4)) - (assert (= (ap-last (> it 10) (range 10)) None))) + (assert (= (ap-last (> it 10) (range 10)) None)) + + (assert (= + (->> [1 2 3 4] + (ap-map (+ 4 it)) + (ap-last (odd? it))) + 7))) (defn test-ap-reduce [] (assert (= (ap-reduce (* acc it) [1 2 3]) 6)) @@ -86,7 +158,13 @@ (assert (= (ap-reduce (* acc it) (do (+= expr-evaluated 1) [4 5 6]))) 120) - (assert (= expr-evaluated 1))) + (assert (= expr-evaluated 1)) + + (assert (= + (->> [1 2 3] + (ap-map (+ 2 it)) + (ap-reduce (* acc it))) + 60))) (defn test-tag-fn [] ;; test ordering