Yaltik/hy
2
0
Fork 0
Code Pull Requests Releases Activity

Merge pull request #1647 from gilch/let-rebind

Browse Source 
Fix let rebind bug.
This commit is contained in:
gilch 2018-07-08 21:52:32 -06:00 committed by GitHub
commit 0de8557fb5
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
2 changed files with 160 additions and 198 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

63
hy/contrib/walk.hy
View File

@ -305,6 +305,7 @@ as can nested let forms.
(macro-error bindings "let bindings must be paired"))
(setv g!let (gensym 'let)
replacements (OrderedDict)
keys []
values [])
(defn expander [symbol]
(.get replacements symbol symbol))
@ -313,63 +314,15 @@ as can nested let forms.
(macro-error k "bind targets must be symbols")
(if (in '. k)
(macro-error k "binding target may not contain a dot")))
(.append values (symbolexpand (macroexpand-all v &name) expander))
(assoc replacements k `(get ~g!let ~(name k))))
(.append values (symbolexpand (macroexpand-all v &name)
expander))
(.append keys `(get ~g!let ~(name k)))
(assoc replacements k (last keys)))
`(do
(setv ~g!let {}
~@(interleave (.values replacements) values))
~@(symbolexpand (macroexpand-all body &name) expander)))
~@(interleave keys values))
~@(symbolexpand (macroexpand-all body &name)
expander)))
;; (defmacro macrolet [])
#_[special cases for let
;; Symbols containing a dot should be converted to this form.
;; attrs should not get expanded,
;; but [] lookups should.
'.',
;;; can shadow let bindings with Python locals
;; protect its bindings for the lexical scope of its body.
'fn',
'fn*',
;; protect as bindings for the lexical scope of its body
'except',
;;; changes scope of named variables
;; protect the variables they name for the lexical scope of their container
'global',
'nonlocal',
;; should we provide a protect form?
;; it's an anaphor only valid in a `let` body.
;; this would make the named variables python-scoped in its body
;; expands to a do
'protect',
;;; quoted variables must not be expanded.
;; but unprotected, unquoted variables must be.
'quasiquote',
'quote',
'unquote',
'unquote-splice',
;;;; deferred
;; should really only exist at toplevel. Ignore until someone complains?
;; raise an error? treat like fn?
;; should probably be implemented as macros in terms of fn/setv anyway.
'defmacro',
'deftag',
;;; create Python-scoped variables. It's probably hard to avoid this.
;; Best just doc this behavior for now.
;; we can't avoid clobbering enclosing python scope, unless we use a gensym,
;; but that corrupts '__name__'.
;; It could be set later, but that could mess up metaclasses!
;; Should the class name update let variables too?
'defclass',
;; should this update let variables?
;; it could be done with gensym/setv.
'import',
;; I don't understand these. Ignore until someone complains?
'eval_and_compile', 'eval_when_compile', 'require',]

295
tests/native_tests/contrib/walk.hy
View File

@ -64,16 +64,16 @@
b "b")
(let [a "x"
b "y"]
(assert (= (+ a b)
"xy"))
(let [a "z"]
(assert (= (+ a b)
"zy")))
;; let-shadowed variable doesn't get clobbered.
(assert (= (+ a b)
"xy")))
(assert (= (+ a b)
"xy"))
(let [a "z"]
(assert (= (+ a b)
"zy")))
;; let-shadowed variable doesn't get clobbered.
(assert (= (+ a b)
"xy")))
(let [q "q"]
(assert (= q "q")))
(assert (= q "q")))
(assert (= a "a"))
(assert (= b "b"))
(assert (in "a" (.keys (vars))))
@ -85,86 +85,86 @@
(let [a "a"
b "b"
ab (+ a b)]
(assert (= ab "ab"))
(let [c "c"
abc (+ ab c)]
(assert (= abc "abc")))))
(assert (= ab "ab"))
(let [c "c"
abc (+ ab c)]
(assert (= abc "abc")))))
(defn test-let-early []
(setv a "a")
(let [q (+ a "x")
a 2 ; should not affect q
b 3]
(assert (= q "ax"))
(let [q (* a b)
a (+ a b)
b (* a b)]
(assert (= q 6))
(assert (= a 5))
(assert (= b 15))))
(assert (= q "ax"))
(let [q (* a b)
a (+ a b)
b (* a b)]
(assert (= q 6))
(assert (= a 5))
(assert (= b 15))))
(assert (= a "a")))
(defn test-let-special []
;; special forms in function position still work as normal
(let [, 1]
(assert (= (, , ,)
(, 1 1)))))
(assert (= (, , ,)
(, 1 1)))))
(defn test-let-quasiquote []
(setv a-symbol 'a)
(let [a "x"]
(assert (= a "x"))
(assert (= 'a a-symbol))
(assert (= `a a-symbol))
(assert (= `(foo ~a)
'(foo "x")))
(assert (= `(foo `(bar a ~a ~~a))
'(foo `(bar a ~a ~"x"))))
(assert (= `(foo ~@[a])
'(foo "x")))
(assert (= `(foo `(bar [a] ~@[a] ~@~[a 'a `a] ~~@[a]))
'(foo `(bar [a] ~@[a] ~@["x" a a] ~"x"))))))
(assert (= a "x"))
(assert (= 'a a-symbol))
(assert (= `a a-symbol))
(assert (= `(foo ~a)
'(foo "x")))
(assert (= `(foo `(bar a ~a ~~a))
'(foo `(bar a ~a ~"x"))))
(assert (= `(foo ~@[a])
'(foo "x")))
(assert (= `(foo `(bar [a] ~@[a] ~@~[a 'a `a] ~~@[a]))
'(foo `(bar [a] ~@[a] ~@["x" a a] ~"x"))))))
(defn test-let-except []
(let [foo 42
bar 33]
(assert (= foo 42))
(try
(do
1/0
(assert False))
(except [foo Exception]
;; let bindings should work in except block
(assert (= bar 33))
;; but exception bindings can shadow let bindings
(assert (instance? Exception foo))))
;; let binding did not get clobbered.
(assert (= foo 42))))
(assert (= foo 42))
(try
(do
1/0
(assert False))
(except [foo Exception]
;; let bindings should work in except block
(assert (= bar 33))
;; but exception bindings can shadow let bindings
(assert (instance? Exception foo))))
;; let binding did not get clobbered.
(assert (= foo 42))))
(defn test-let-mutation []
(setv foo 42)
(setv error False)
(let [foo 12
bar 13]
(assert (= foo 12))
(setv foo 14)
(assert (= foo 14))
(del foo)
;; deleting a let binding should not affect others
(assert (= bar 13))
(try
;; foo=42 is still shadowed, but the let binding was deleted.
(do
foo
(assert False))
(except [le LookupError]
(setv error le)))
(setv foo 16)
(assert (= foo 16))
(setv [foo bar baz] [1 2 3])
(assert (= foo 1))
(assert (= bar 2))
(assert (= baz 3)))
(assert (= foo 12))
(setv foo 14)
(assert (= foo 14))
(del foo)
;; deleting a let binding should not affect others
(assert (= bar 13))
(try
;; foo=42 is still shadowed, but the let binding was deleted.
(do
foo
(assert False))
(except [le LookupError]
(setv error le)))
(setv foo 16)
(assert (= foo 16))
(setv [foo bar baz] [1 2 3])
(assert (= foo 1))
(assert (= bar 2))
(assert (= baz 3)))
(assert error)
(assert (= foo 42))
(assert (= baz 3)))
@ -172,40 +172,40 @@
(defn test-let-break []
(for [x (range 3)]
(let [done (odd? x)]
(if done (break))))
(if done (break))))
(assert (= x 1)))
(defn test-let-continue []
(let [foo []]
(for [x (range 10)]
(let [odd (odd? x)]
(if odd (continue))
(.append foo x)))
(assert (= foo [0 2 4 6 8]))))
(for [x (range 10)]
(let [odd (odd? x)]
(if odd (continue))
(.append foo x)))
(assert (= foo [0 2 4 6 8]))))
(defn test-let-yield []
(defn grind []
(yield 0)
(let [a 1
b 2]
(yield a)
(yield b)))
(yield a)
(yield b)))
(assert (= (tuple (grind))
(, 0 1 2))))
(defn test-let-return []
(defn get-answer []
(let [answer 42]
(return answer)))
(return answer)))
(assert (= (get-answer)
42)))
(defn test-let-import []
(let [types 6]
;; imports don't fail, even if using a let-bound name
(import types)
;; let-bound name is not affected
(assert (= types 6)))
;; imports don't fail, even if using a let-bound name
(import types)
;; let-bound name is not affected
(assert (= types 6)))
;; import happened in Python scope.
(assert (in "types" (vars)))
(assert (instance? types.ModuleType types)))
@ -213,13 +213,13 @@
(defn test-let-defclass []
(let [Foo 42
quux object]
;; the name of the class is just a symbol, even if it's a let binding
(defclass Foo [quux] ; let bindings apply in inheritance list
;; let bindings apply inside class body
(setv x Foo)
;; quux is not local
(setv quux "quux"))
(assert (= quux "quux")))
;; the name of the class is just a symbol, even if it's a let binding
(defclass Foo [quux] ; let bindings apply in inheritance list
;; let bindings apply inside class body
(setv x Foo)
;; quux is not local
(setv quux "quux"))
(assert (= quux "quux")))
;; defclass always creates a python-scoped variable, even if it's a let binding name
(assert (= Foo.x 42)))
@ -229,82 +229,82 @@
(let [a 1
b []
bar (fn [])]
(setv bar.a 13)
(assert (= bar.a 13))
(setv (. bar a) 14)
(assert (= bar.a 14))
(assert (= a 1))
(assert (= b []))
;; method syntax not affected
(.append b 2)
(assert (= b [2]))
;; attrs access is not affected
(assert (= foo.a 42))
(assert (= (. foo a)
42))
;; but indexing is
(assert (= (. [1 2 3]
[a])
2))))
(setv bar.a 13)
(assert (= bar.a 13))
(setv (. bar a) 14)
(assert (= bar.a 14))
(assert (= a 1))
(assert (= b []))
;; method syntax not affected
(.append b 2)
(assert (= b [2]))
;; attrs access is not affected
(assert (= foo.a 42))
(assert (= (. foo a)
42))
;; but indexing is
(assert (= (. [1 2 3]
[a])
2))))
(defn test-let-positional []
(let [a 0
b 1
c 2]
(defn foo [a b]
(, a b c))
(assert (= (foo 100 200)
(, 100 200 2)))
(setv c 300)
(assert (= (foo 1000 2000)
(, 1000 2000 300)))
(assert (= a 0))
(assert (= b 1))
(assert (= c 300))))
(defn foo [a b]
(, a b c))
(assert (= (foo 100 200)
(, 100 200 2)))
(setv c 300)
(assert (= (foo 1000 2000)
(, 1000 2000 300)))
(assert (= a 0))
(assert (= b 1))
(assert (= c 300))))
(defn test-let-rest []
(let [xs 6
a 88
c 64
&rest 12]
(defn foo [a b &rest xs]
(-= a 1)
(setv xs (list xs))
(.append xs 42)
(, &rest a b c xs))
(assert (= xs 6))
(assert (= a 88))
(assert (= (foo 1 2 3 4)
(, 12 0 2 64 [3 4 42])))
(assert (= xs 6))
(assert (= c 64))
(assert (= a 88))))
(defn foo [a b &rest xs]
(-= a 1)
(setv xs (list xs))
(.append xs 42)
(, &rest a b c xs))
(assert (= xs 6))
(assert (= a 88))
(assert (= (foo 1 2 3 4)
(, 12 0 2 64 [3 4 42])))
(assert (= xs 6))
(assert (= c 64))
(assert (= a 88))))
(defn test-let-kwargs []
(let [kws 6
&kwargs 13]
(defn foo [&kwargs kws]
(, &kwargs kws))
(assert (= kws 6))
(assert (= (foo :a 1)
(, 13 {"a" 1})))))
(defn foo [&kwargs kws]
(, &kwargs kws))
(assert (= kws 6))
(assert (= (foo :a 1)
(, 13 {"a" 1})))))
(defn test-let-optional []
(let [a 1
b 6
d 2]
(defn foo [&optional [a a] b [c d]]
(, a b c))
(assert (= (foo)
(, 1 None 2)))
(assert (= (foo 10 20 30)
(, 10 20 30)))))
(defn foo [&optional [a a] b [c d]]
(, a b c))
(assert (= (foo)
(, 1 None 2)))
(assert (= (foo 10 20 30)
(, 10 20 30)))))
(defn test-let-closure []
(let [count 0]
(defn +count [&optional [x 1]]
(+= count x)
count))
(defn +count [&optional [x 1]]
(+= count x)
count))
;; let bindings can still exist outside of a let body
(assert (= 1 (+count)))
(assert (= 2 (+count)))
@ -323,9 +323,18 @@
(let [a 1
b (triple a)
c (ap-triple)]
(assert (= (triple a)
3))
(assert (= (ap-triple)
3))
(assert (= b 3))
(assert (= c 3))))
(assert (= (triple a)
3))
(assert (= (ap-triple)
3))
(assert (= b 3))
(assert (= c 3))))
(defn test-let-rebind []
(let [x "foo"
y "bar"
x (+ x y)
y (+ y x)
x (+ x x)]
(assert (= x "foobarfoobar"))
(assert (= y "barfoobar"))))