Skip to content

Commit

Permalink
Backport macroexpansion middleware fixes from master
Browse files Browse the repository at this point in the history
  • Loading branch information
@cichli
cichli committed Dec 27, 2015
1 parent 33edf07 commit 4bba843
Show file tree
Hide file tree
Showing 2 changed files with 204 additions and 166 deletions.
167 changes: 100 additions & 67 deletions src/cider/nrepl/middleware/macroexpand.clj
View file
Original file line number Diff line number Diff line change
@@ -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")
Expand All @@ -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."}}}})
Loading

0 comments on commit 4bba843

Please sign in to comment.