fix premature binding in let

hy/contrib/walk.hy

@@ -5,7 +5,9 @@
 
 (import [hy [HyExpression HyDict]]
         [functools [partial]]
-        [collections [OrderedDict]])
+        [collections [OrderedDict]]
+        [hy.macros [macroexpand :as mexpand]]
+        [hy.compiler [HyASTCompiler]])
 
 (defn walk [inner outer form]
   "Traverses form, an arbitrary data structure. Applies inner to each
@@ -40,9 +42,10 @@
   (and (instance? HyExpression form)
        form))
 
-(defn macroexpand-all [form]
+(defn macroexpand-all [form &optional module-name]
   "Recursively performs all possible macroexpansions in form."
-  (setv quote-level [0])  ; TODO: make nonlocal after dropping Python2
+  (setv module-name (or module-name (calling-module-name))
+        quote-level [0])  ; TODO: make nonlocal after dropping Python2
   (defn traverse [form]
     (walk expand identity form))
   (defn expand [form]
@@ -56,17 +59,17 @@
       (-= (get quote-level 0) x)
       `(~head ~@res))
     (if (call? form)
-      (cond [(get quote-level 0)
-             (cond [(in (first form) '[unquote unquote-splice])
-                    (+quote -1)]
-                   [(= (first form) 'quasiquote) (+quote)]
-                   [True (traverse form)])]
-            [(= (first form) 'quote) form]
-            [(= (first form) 'quasiquote) (+quote)]
-            [True (traverse (macroexpand form))])
-      (if (coll? form)
-        (traverse form)
-        form)))
+        (cond [(get quote-level 0)
+               (cond [(in (first form) '[unquote unquote-splice])
+                      (+quote -1)]
+                     [(= (first form) 'quasiquote) (+quote)]
+                     [True (traverse form)])]
+              [(= (first form) 'quote) form]
+              [(= (first form) 'quasiquote) (+quote)]
+              [True (traverse (mexpand form (HyASTCompiler module-name)))])
+        (if (coll? form)
+            (traverse form)
+            form)))
   (expand form))
 
 (setv special-forms (list-comp k
@@ -262,7 +265,7 @@ Arguments without a header are under None.
         ;; recursive base case--it's an atom. Put it back.
         (self.handle-base))))
 
-(defmacro smacrolet [bindings &rest body]
+(defmacro smacrolet [bindings &optional module-name &rest body]
   "
 symbol macro let.
 
@@ -277,7 +280,7 @@ The bindings pairs the target symbol and the expansion form for that symbol.
             (if (in '. k)
                 (macro-error k "binding target may not contain a dot"))))
   (setv bindings (dict (partition bindings))
-        body (macroexpand-all body))
+        body (macroexpand-all body (or module-name (calling-module-name))))
   (symbolexpand `(do ~@body)
                 (fn [symbol]
                   (.get bindings symbol symbol))))
@@ -302,20 +305,23 @@ if you must avoid this hoisting.
 Function arguments can shadow let bindings in their body,
 as can nested let forms.
 "
-  (setv g!let (gensym 'let)
-        symbols (cut bindings None None 2))
   (if (odd? (len bindings))
       (macro-error bindings "let bindings must be paired"))
-  (for [k symbols]
+  (setv g!let (gensym 'let)
+        replacements (OrderedDict)
+        values [])
+  (defn expander [symbol]
+    (.get replacements symbol symbol))
+  (for [[k v] (partition bindings)]
     (if-not (symbol? k)
-            (macro-error k "let can only bind to symbols")))
-  (macroexpand
-    `(smacrolet [~@(interleave symbols
-                               (genexpr (HySymbol (+ g!let "::" symbol))
-                                        [symbol symbols]))]
-                (do
-                  (setv ~@bindings)
-                  ~@body))))
+            (macro-error k "bind targets must be symbols")
+            (if (in '. k)
+                (macro-error k "binding target may not contain a dot")))
+    (.append values (symbolexpand v expander))
+    (assoc replacements k (HySymbol (+ g!let "::" k))))
+  `(do
+     (setv ~@(interleave (.values replacements) values))
+     ~@(symbolexpand (macroexpand-all body) expander)))
 
 ;; (defmacro macrolet [])
 

tests/native_tests/contrib/walk.hy

@@ -5,6 +5,8 @@
 (import [hy.contrib.walk [*]])
 (require [hy.contrib.walk [*]])
 
+(import pytest)
+
 (def walk-form '(print {"foo" "bar"
                         "array" [1 2 3 [4]]
                         "something" (+ 1 2 3 4)
@@ -35,7 +37,13 @@
                    (drop 1 [1 [2 [3 [4]]]]))
              [[2 [3 [4]] 2 [3 [4]]]])))
 
+(defmacro foo-walk []
+  42)
+
 (defn test-macroexpand-all []
+  ;; make sure a macro from the current module works
+  (assert (= (macroexpand-all '(foo-walk))
+             42))
   (assert (= (macroexpand-all '(with [a 1]))
              '(with* [a 1] (do))))
   (assert (= (macroexpand-all '(with [a 1 b 2 c 3] (for [d c] foo)))
@@ -74,6 +82,7 @@
   (assert (not-in "q" (.keys (vars)))))
 
 (defn test-let-sequence []
+  ;; assignments happen in sequence, not parallel.
   (let [a "a"
         b "b"
         ab (+ a b)]
@@ -82,6 +91,20 @@
              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 (= a "a")))
+
 (defn test-let-special []
   ;; special forms in function position still work as normal
   (let [, 1]
@@ -311,3 +334,24 @@
                        'let-global)
                   "mutated"))))
 
+(defmacro triple [a]
+  (setv g!a (gensym a))
+  `(do
+     (setv ~g!a ~a)
+     (+ ~g!a ~g!a ~g!a)))
+
+(defmacro ap-triple []
+  '(+ a a a))
+
+#@(pytest.mark.xfail
+    (defn test-let-macros []
+      (let [a 1
+            b (triple a)
+            c (ap-triple)]
+           (assert (= (triple a)
+                      3))
+           (assert (= (ap-triple)
+                      3))
+           (assert (= b 3))
+           (assert (= c 3)))))
+