From 5bbf4d9894a1880e5dc30d308a2bf684ceb70345 Mon Sep 17 00:00:00 2001 From: gilch Date: Fri, 22 Sep 2017 20:07:48 -0600 Subject: [PATCH] fix premature binding in `let` --- hy/contrib/walk.hy | 60 ++++++++++++++++-------------- tests/native_tests/contrib/walk.hy | 44 ++++++++++++++++++++++ 2 files changed, 77 insertions(+), 27 deletions(-) diff --git a/hy/contrib/walk.hy b/hy/contrib/walk.hy index e4fe774..485d169 100644 --- a/hy/contrib/walk.hy +++ b/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 []) diff --git a/tests/native_tests/contrib/walk.hy b/tests/native_tests/contrib/walk.hy index 66ad7f7..063cd49 100644 --- a/tests/native_tests/contrib/walk.hy +++ b/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))))) +