Reduce scope of symbol replacement for anaphoric macros

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
 ==============================
 

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
+it's unwise to nest these macros where symbol replacement is happening.
-something other than a variable name, as in ``(print "My favorite
+Symbol replacement typically takes place in ``body`` or ``form``
-Stephen King book is" 'it)``.
+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:
 

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)
+     (setv ~it ~test-form)
-     (if it ~then-form ~else-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]
+  (rit `(for [~it ~xs]
-    (unless ~form
+    (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)]
+  (rit `(for [~it (range ~n)]
-    ~@body)))
+    ~@(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]
+    (for  [~it ~xs  :if ~(R form)]
-      (setv ~x it))
+      (setv ~x ~it))
     ~x)))
 
-
 (defmacro! ap-reduce [form o!xs &optional [initial-value None]]
-  (recur-sym-replace {'it (gensym)  'acc (gensym)} `(do
+  (setv
-     (setv acc ~(if (none? initial-value)
+    it (gensym)
-       `(do
+    acc (gensym))
-         (setv ~g!xs (iter ~g!xs))
+  (defn R [form]
-         (next ~g!xs))
+    (recur-sym-replace {'it it  'acc acc} form))
-       initial-value))
+  `(do
-     (for [it ~g!xs]
+    (setv ~acc ~(if (none? initial-value)
-       (setv acc ~form))
+      `(do
-     acc)))
+        (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))

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