gistfile1.clj

(require '[clojure.tools.analyzer :as a]
         '[clojure.tools.analyzer.jvm :as a.j]
         '[clojure.tools.analyzer.ast :as ast]
         '[clojure.tools.analyzer.utils :as u]
         '[clojure.tools.analyzer.passes.jvm.emit-form :as j.e]
         '[clojure.tools.analyzer.passes.emit-form :as e])

(defn ^:private mexpansions
  ([ast _] (mexpansions ast))
  ([ast]
     (binding [e/-emit-form* mexpansions]
       (or (:raw ast)
           (j.e/-emit-form* ast {})))))

(def ^:private ^:dynamic continue)
(defn deps
  "Takes a form and returns a set of the vars it depends on"
  [form]
  (let [deps      (atom #{})
        mexpander (fn [form env]
                    (let [f (if (seq? form) (first form) form)
                          v (u/resolve-var f env)]
                      (when-let [var? (and (not (-> env :locals (get f)))
                                           (var? v))]
                        (swap! deps conj v)))
                    (a.j/macroexpand-1 form env))]
    (a.j/analyze form (a.j/empty-env)
                 {:bindings {#'a/macroexpand-1 mexpander}})
    @deps))

(defn mexpansion-steps
  "Takes a form and returns a seq of all the macroexpansion steps
   the compiler will apply.

   If include-meta? is true, will include the macroexpansion steps of
   metadata forms."
  ([form] (mexpansion-steps false))
  ([form include-meta?]
     (let [a    (a.j/analyze form)
           c    (count (mapcat :raw-forms (ast/nodes a)))
           asts (loop [a a asts [] i 0]
                  (if (< i c)
                    (let [f (fn f [ast]
                              (if continue
                                (if-let [[r & rs] (seq (:raw-forms ast))]
                                  (do (set! continue false)
                                      (assoc ast :raw r :raw-forms rs))
                                  (ast/update-children ast f))
                                ast))
                          a (binding [continue true]
                              (f a))]
                      (recur (ast/prewalk a #(dissoc % :raw)) (conj asts a) (inc i)))
                    (conj asts a)))]
       ((if include-meta? identity dedupe)
        (mapv mexpansions asts)))))