Merge pull request #1884 from eganjs/fix-anaphoric-macros

Reduce scope of symbol replacement for anaphoric macros
This commit is contained in:
Kodi Arfer 2020-03-31 11:25:03 -04:00 committed by GitHub
commit 30f91f0c66
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
5 changed files with 142 additions and 44 deletions

View File

@ -98,3 +98,4 @@
* Gábor Lipták <gliptak@gmail.com>
* Raymund MARTINEZ <zhaqenl@protonmail.com>
* Zepeng Zhang <redraiment@gmail.com>
* Joseph Egan <joseph.s.egan@gmail.com>

View File

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

View File

@ -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:

View File

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

View File

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