From 4bba8436bbdcf51b105b0bd04f592f23cfdd36da Mon Sep 17 00:00:00 2001 From: Michael Griffiths Date: Sun, 27 Dec 2015 13:37:03 +0000 Subject: [PATCH] Backport macroexpansion middleware fixes from master --- src/cider/nrepl/middleware/macroexpand.clj | 167 ++++++++------ .../nrepl/middleware/macroexpand_test.clj | 203 +++++++++--------- 2 files changed, 204 insertions(+), 166 deletions(-) diff --git a/src/cider/nrepl/middleware/macroexpand.clj b/src/cider/nrepl/middleware/macroexpand.clj index 2677b19c1..f2d6d8019 100644 --- a/src/cider/nrepl/middleware/macroexpand.clj +++ b/src/cider/nrepl/middleware/macroexpand.clj @@ -1,82 +1,114 @@ (ns cider.nrepl.middleware.macroexpand "Macroexpansion middleware." {:author "Bozhidar Batsov"} - (:require [clojure.pprint :as pp] - [clojure.walk :as walk] - [clojure.tools.nrepl.transport :as transport] + (:require [cider.nrepl.middleware.util.misc :as u] + [clojure.pprint :as pp] [clojure.tools.nrepl.middleware :refer [set-descriptor!]] [clojure.tools.nrepl.misc :refer [response-for]] - [cider.nrepl.middleware.util.misc :as u])) + [clojure.tools.nrepl.transport :as transport] + [clojure.walk :as walk]) + (:import [clojure.lang Var])) + +(defn- var->namespace-qualified-name [^Var v] + (symbol (str (.name (.ns v))) + (str (.sym v)))) + +(defn- tidy-namespaced-sym + "Given a namespace-qualified symbol, returns the symbol to be printed when + the :display-namespaces option is set to 'tidy. + + * sym is the namespace-qualified symbol to be tidied. + * ns is the name of the namespace in which macroexpansion is being performed. + * aliases is a map from namespace name to namespace alias. + * refers is a map from non-namespace-qualified referred vars to their namespace-qualified names." + [sym ns aliases refers] + (let [ns-sym (symbol (namespace sym)) + name-sym (symbol (name sym)) + alias (get aliases ns-sym)] + (cond + ;; The namespace has an alias + alias (symbol (str alias) (str name-sym)) + ;; The var is defined in the current namespace + (= ns-sym ns) name-sym + ;; The var is referred to + (= sym (get refers name-sym)) name-sym + ;; No alias and from a different namespace + :else sym))) -(defn- resolve-expander [expander] - (let [sym (symbol expander)] - (if (= sym 'macroexpand-all) - (ns-resolve 'clojure.walk sym) - (resolve sym)))) +(defn- resolve-expander + "Returns the macroexpansion fn for macroexpanding Clojure code, corresponding + to the given value of the :expander option." + [expander] + (case expander + "macroexpand-1" macroexpand-1 + "macroexpand" macroexpand + "macroexpand-all" walk/macroexpand-all + (throw (IllegalArgumentException. (format "Unrecognized expander: %s" expander))))) -(defn- tidy-qualified-var-refs - "Takes a `form` (usually being the result of a macroexpansion) and replaces - any fully qualified var references with the namespace aliases defined for the - namespace `ns`. Var references to vars of the current namespace `ns` are - replaced with simple names." - [form ns] - (let [alias2ns (ns-aliases ns) - ns2alias (apply hash-map (mapcat (fn [[a n]] - [(ns-name n) a]) - alias2ns))] - (walk/prewalk - (fn [x] - (if (and (symbol? x) (namespace x)) - (let [symb-ns (symbol (namespace x)) - symb-name (symbol (name x)) - alias (ns2alias symb-ns)] - (cond - ;; That namespace has an alias - alias (symbol (str alias "/" symb-name)) - ;; That var is defined in the current namespace - (= symb-ns (ns-name ns)) symb-name - ;; The var is referred to - ((ns-refers ns) symb-name) symb-name - ;; No alias and from a different namespace - :else x)) - x)) - form))) +(defn- tidy-walker + "Returns a fn suitable for passing to clojure.walk/prewalk for processing a + macroexpanded form according to the 'tidy value of the :display-namespaces + option. See the docstring of tidy-namespaced-sym for the meaning of aliases + and refers." + [{:keys [ns]}] + (let [aliases (->> (ns-aliases ns) + (map (fn [[a n]] + [(ns-name n) a])) + (into {})) + refers (->> (ns-refers ns) + (map (fn [[r v]] + [r (var->namespace-qualified-name v)])) + (into {}))] + (fn [x] + (cond-> x + (and (symbol? x) (namespace x)) + (tidy-namespaced-sym ns aliases refers))))) -(defn macroexpansion [expander code ns-name display-namespaces print-meta] - ;; display-namespaces can either be - ;; "tidy" => print aliases instead of qnames, simple names if - ;; var is refered to or defined in the same ns - ;; "qualified" => print qnames - ;; "none" => print simple names - (let [suppress-namespaces (= display-namespaces "none") - expansion-fn (resolve-expander expander) - ns (find-ns (symbol ns-name)) - ;; we have to do the macroexpansion in the proper ns context - expansion (binding [*ns* ns] (expansion-fn (read-string code))) - ;; post-process expansions if display namespaces is "tidy" - [expansion suppress-namespaces] (if (= display-namespaces "tidy") - [(tidy-qualified-var-refs expansion ns) false] - [expansion suppress-namespaces]) - suppress-namespaces (boolean suppress-namespaces)] +(defn- post-expansion-walker + "Returns a fn suitable for passing to clojure.walk/prewalk for processing a + macroexpanded Clojure form according to the given value of + the :display-namespaces option." + [{:keys [display-namespaces ns] :as msg}] + (case display-namespaces + "qualified" identity + "none" (fn [x] + (cond-> x + (and (symbol? x) (namespace x)) + (-> name symbol))) + "tidy" (tidy-walker msg) + (throw (IllegalArgumentException. (format "Unrecognized value for display-namespaces: %s" display-namespaces))))) + +(defn- expand + "Returns the macroexpansion of the given Clojure form :code, performed in the + context of the given :ns, using the provided :expander and :display-namespaces + options." + [{:keys [code expander ns] :as msg}] + (->> (let [expander-fn (resolve-expander expander)] + (binding [*ns* (find-ns ns)] + (expander-fn (read-string code)))) + (walk/prewalk (post-expansion-walker msg)))) + +(defn macroexpansion [{:keys [print-meta ns] :as msg}] + (let [msg (merge {:expander "macroexpand" :display-namespaces "qualified"} msg) + expansion (expand (assoc msg :ns (or (u/as-sym ns) 'user)))] (with-out-str (binding [*print-meta* (boolean print-meta)] - (pp/write expansion - :suppress-namespaces suppress-namespaces - :dispatch clojure.pprint/code-dispatch))))) + (pp/write expansion :dispatch pp/code-dispatch))))) (defn macroexpansion-reply - [{:keys [transport expander code ns display-namespaces print-meta] :as msg}] + [{:keys [transport] :as msg}] (try - (let [expansion (macroexpansion expander code ns display-namespaces print-meta)] - (transport/send - transport - (response-for msg :expansion expansion :status :done))) + (transport/send + transport + (response-for msg {:expansion (macroexpansion msg) + :status :done})) (catch Exception e (transport/send - transport (response-for msg (u/err-info e :macroexpand-error)))))) + transport + (response-for msg (u/err-info e :macroexpand-error)))))) (defn wrap-macroexpand - "Middleware that provides macroexpansion ops." + "Middleware that provides a macroexpand op." [handler] (fn [{:keys [op] :as msg}] (if (= op "macroexpand") @@ -87,9 +119,10 @@ #'wrap-macroexpand {:handles {"macroexpand" - {:doc "Produces macroexpansion of some form using macroexpand." - :requires {"code" "The form to macroexpand." - "expander" "The macroexpansion function which to use." - "ns" "The namespace in which to perform the macroexpansion."} - :optional {"print-meta" "If truthy, also print metadata of forms."} + {:doc "Produces macroexpansion of some form using the given expander." + :requires {"code" "The form to macroexpand."} + :optional {"ns" "The namespace in which to perform the macroexpansion. Defaults to 'user for Clojure and 'cljs.user for ClojureScript." + "expander" "The macroexpansion function to use. Possible values are \"macroexpand-1\", \"macroexpand\", or \"macroexpand-all\". Defaults to \"macroexpand\"." + "display-namespaces" "How to print namespace-qualified symbols in the result. Possible values are \"qualified\" to leave all namespaces qualified, \"none\" to elide all namespaces, or \"tidy\" to replace namespaces with their aliases in the given namespace. Defaults to \"qualified\"." + "print-meta" "If truthy, also print metadata of forms."} :returns {"expansion" "The macroexpanded form."}}}}) diff --git a/test/clj/cider/nrepl/middleware/macroexpand_test.clj b/test/clj/cider/nrepl/middleware/macroexpand_test.clj index d007295fc..4786015fa 100644 --- a/test/clj/cider/nrepl/middleware/macroexpand_test.clj +++ b/test/clj/cider/nrepl/middleware/macroexpand_test.clj @@ -1,124 +1,129 @@ (ns cider.nrepl.middleware.macroexpand-test - (:require [cider.nrepl.middleware.macroexpand :refer :all] - [cider.nrepl.test-transport :refer :all] + (:refer-clojure :exclude [zero? zipmap]) + (:require [cider.nrepl.test-session :as session] [clojure.set :as set] [clojure.string] [clojure.test :refer :all])) +(use-fixtures :once session/session-fixture) + (def code {:expr "(while (while 1))" :expanded "(loop* [] (when (while 1) (recur)))" :expanded-1 "(loop [] (when (while 1) (recur)))" :expanded-all "(loop* [] (if (loop* [] (if 1 (do (recur)))) (do (recur))))"}) -(deftest test-macroexpand-1-op - (let [transport (test-transport)] - (macroexpansion-reply {:transport transport - :op "macroexpand" - :expander "macroexpand-1" - :code (:expr code) - :ns "clojure.core" - :display-namespaces "none"}) - (is (= (messages transport) - [{:expansion (:expanded-1 code) :status #{:done}}])))) +(deftest expander-option + (testing "macroexpand-1 expander works" + (let [{:keys [expansion status]} (session/message {:op "macroexpand" + :expander "macroexpand-1" + :code (:expr code) + :display-namespaces "none"})] + (is (= (:expanded-1 code) expansion)) + (is (= #{"done"} status)))) + + (testing "macroexpand expander works" + (let [{:keys [expansion status]} (session/message {:op "macroexpand" + :expander "macroexpand" + :code (:expr code) + :display-namespaces "none"})] + (is (= (:expanded code) expansion)) + (is (= #{"done"} status)))) + + (testing "macroexpand-all expander works" + (let [{:keys [expansion status]} (session/message {:op "macroexpand" + :expander "macroexpand-all" + :code (:expr code) + :display-namespaces "none"})] + (is (= (:expanded-all code) expansion)) + (is (= #{"done"} status)))) -(deftest test-macroexpand-op - (let [transport (test-transport)] - (macroexpansion-reply {:transport transport - :op "macroexpand" - :expander "macroexpand" - :code (:expr code) - :ns "clojure.core" - :display-namespaces "none"}) - (is (= (messages transport) - [{:expansion (:expanded code) :status #{:done}}])))) + (testing "macroexpand is the default expander" + (let [{:keys [expansion status]} (session/message {:op "macroexpand" + :code (:expr code) + :display-namespaces "none"})] + (is (= (:expanded code) expansion)) + (is (= #{"done"} status)))) -(deftest test-macroexpand-all-op - (let [transport (test-transport)] - (macroexpansion-reply {:transport transport - :op "macroexpand" - :expander "macroexpand-all" - :code (:expr code) - :ns "clojure.core" - :display-namespaces "none"}) - (is (= (messages transport) - [{:expansion (:expanded-all code) :status #{:done}}])))) + (testing "invalid expander" + (let [{:keys [err ex status]} (session/message {:op "macroexpand" + :expander "foo" + :code "(defn x [] nil)"})] + (is err) + (is ex) + (is (= #{"done" "macroexpand-error"} status))))) ;; Tests for the three different cider-macroexpansion-display-namespaces ;; values: nil, t, and 'tidy +(def zipmap nil) (def my-set #{2 3}) (defmacro ^:private tidy-test-macro [] `(deftest ~'test-foo + ;; excluded var, namespace-qualified + (is (clojure.core/zero? 0)) + ;; excluded var, shadowed locally + (is (nil? zipmap)) + ;; referred ns, without alias (is (clojure.string/blank? "")) - (is (= my-set (set/intersection #{1 2 3} #{2 3 4}))))) + ;; referred ns, with alias + (is (= my-set (set/intersection (hash-set 1 2 3) (hash-set 2 3 4)))))) + +(deftest display-namespaces-option + (testing "macroexpand-1 expander with display-namespaces: qualified" + (let [{:keys [expansion status]} (session/message {:op "macroexpand" + :expander "macroexpand-1" + :code "(tidy-test-macro)" + :ns "cider.nrepl.middleware.macroexpand-test" + :display-namespaces "qualified"})] + (is (= "(clojure.test/deftest\n test-foo\n (clojure.test/is (clojure.core/zero? 0))\n (clojure.test/is\n (clojure.core/nil? cider.nrepl.middleware.macroexpand-test/zipmap))\n (clojure.test/is (clojure.string/blank? \"\"))\n (clojure.test/is\n (clojure.core/=\n cider.nrepl.middleware.macroexpand-test/my-set\n (clojure.set/intersection\n (clojure.core/hash-set 1 2 3)\n (clojure.core/hash-set 2 3 4)))))" + expansion)) + (is (= #{"done"} status)))) + + (testing "qualified is the default display-namespaces" + (let [{:keys [expansion status]} (session/message {:op "macroexpand" + :expander "macroexpand-1" + :code "(tidy-test-macro)" + :ns "cider.nrepl.middleware.macroexpand-test"})] + (is (= "(clojure.test/deftest\n test-foo\n (clojure.test/is (clojure.core/zero? 0))\n (clojure.test/is\n (clojure.core/nil? cider.nrepl.middleware.macroexpand-test/zipmap))\n (clojure.test/is (clojure.string/blank? \"\"))\n (clojure.test/is\n (clojure.core/=\n cider.nrepl.middleware.macroexpand-test/my-set\n (clojure.set/intersection\n (clojure.core/hash-set 1 2 3)\n (clojure.core/hash-set 2 3 4)))))" + expansion)) + (is (= #{"done"} status)))) -(deftest test-macroexpand-1-op-display-namespaces-qualified - ;; Tests that every var is properly qualified - (let [transport (test-transport)] - (macroexpansion-reply {:transport transport - :op "macroexpand" - :expander "macroexpand-1" - :code "(tidy-test-macro)" - :ns "cider.nrepl.middleware.macroexpand-test" - :display-namespaces "qualified"}) - (let [[val] (messages transport)] - (is (= (:status val) #{:done})) - (is (= (clojure.string/replace (:expansion val) #"[ \t\n]+" " ") - ;; format the set literals instead of hard-coding them in the - ;; string because with different clojure versions, the set #{1 2 - ;; 3} might also be printed as #{1 3 2} or #{3 2 1}. - (format "(clojure.test/deftest test-foo (clojure.test/is (clojure.string/blank? \"\")) (clojure.test/is (clojure.core/= cider.nrepl.middleware.macroexpand-test/my-set (clojure.set/intersection %s %s))))" - #{1 2 3} #{2 3 4})))))) + (testing "macroexpand-1 expander with display-namespaces: none" + (let [{:keys [expansion status]} (session/message {:op "macroexpand" + :expander "macroexpand-1" + :code "(tidy-test-macro)" + :ns "cider.nrepl.middleware.macroexpand-test" + :display-namespaces "none"})] + (is (= "(deftest\n test-foo\n (is (zero? 0))\n (is (nil? zipmap))\n (is (blank? \"\"))\n (is (= my-set (intersection (hash-set 1 2 3) (hash-set 2 3 4)))))" + expansion)) + (is (= #{"done"} status)))) -(deftest test-macroexpand-1-op-display-namespaces-none - ;; Tests that no var is qualified with its namespace - (let [transport (test-transport)] - (macroexpansion-reply {:transport transport - :op "macroexpand" - :expander "macroexpand-1" - :code "(tidy-test-macro)" - :ns "cider.nrepl.middleware.macroexpand-test" - :display-namespaces "none"}) - (let [[val] (messages transport)] - (is (= (:status val) #{:done})) - (is (= (clojure.string/replace (:expansion val) #"[ \t\n]+" " ") - ;; format the set literals instead of hard-coding them in the - ;; string because with different clojure versions, the set #{1 2 - ;; 3} might also be printed as #{1 3 2} or #{3 2 1}. - (format "(deftest test-foo (is (blank? \"\")) (is (= my-set (intersection %s %s))))" - #{1 2 3} #{2 3 4})))))) + (testing "macroexpand-1 expander with display-namespaces: tidy" + (let [{:keys [expansion status]} (session/message {:op "macroexpand" + :expander "macroexpand-1" + :code "(tidy-test-macro)" + :ns "cider.nrepl.middleware.macroexpand-test" + :display-namespaces "tidy"})] + (is (= "(deftest\n test-foo\n (is (clojure.core/zero? 0))\n (is (nil? zipmap))\n (is (clojure.string/blank? \"\"))\n (is (= my-set (set/intersection (hash-set 1 2 3) (hash-set 2 3 4)))))" + expansion)) + (is (= #{"done"} status)))) -(deftest test-macroexpand-1-op-display-namespaces-tidy - ;; Tests that refered vars (deftest, is) and vars of the current ns (my-set) - ;; are not qualified. Vars from other namespaces with an alias are - ;; referenced with the alias (set/intersection). Every other var is fully - ;; qualified (clojure.string/blank?). - (let [transport (test-transport)] - (macroexpansion-reply {:transport transport - :op "macroexpand" - :expander "macroexpand-1" - :code "(tidy-test-macro)" - :ns "cider.nrepl.middleware.macroexpand-test" - :display-namespaces "tidy"}) - (let [[val] (messages transport)] - (is (= (:status val) #{:done})) - (is (= (clojure.string/replace (:expansion val) #"[ \t\n]+" " ") - ;; format the set literals instead of hard-coding them in the - ;; string because with different clojure versions, the set #{1 2 - ;; 3} might also be printed as #{1 3 2} or #{3 2 1}. - (format "(deftest test-foo (is (clojure.string/blank? \"\")) (is (= my-set (set/intersection %s %s))))" - #{1 2 3} #{2 3 4})))))) + (testing "invalid display-namespaces" + (let [{:keys [err ex status]} (session/message {:op "macroexpand" + :code "(defn x [] nil)" + :display-namespaces "foo"})] + (is err) + (is ex) + (is (= #{"done" "macroexpand-error"} status))))) -(deftest test-macroexpand-1-op-print-meta - (let [transport (test-transport) - _ (macroexpansion-reply {:transport transport - :op "macroexpand" - :expander "macroexpand-1" - :code "(defn x [] nil)" - :ns "cider.nrepl.middleware.macroexpand-test" - :display-namespaces "tidy" - :print-meta "true"}) - [val] (messages transport)] - (is (= (:status val) #{:done})) - (is (= (:expansion val) "(def ^{:arglists (quote ([]))} x (fn ([] nil)))")))) +(deftest print-meta-option + (testing "macroexpand-1 expander with print-meta: true" + (let [{:keys [expansion status]} (session/message {:op "macroexpand" + :expander "macroexpand-1" + :code "(defn x [] nil)" + :ns "cider.nrepl.middleware.macroexpand-test" + :display-namespaces "tidy" + :print-meta "true"})] + (is (= "(def ^{:arglists (quote ([]))} x (fn ([] nil)))" expansion)) + (is (= #{"done"} status)))))