Skip to content
Permalink
Browse files

add :qualified-symbols option to emit-form, fully qualify classes whe…

…n set
  • Loading branch information...
Bronsa committed Jul 16, 2014
1 parent 2a88256 commit df55bf039f0eb9aa6c161c363bee3e53629477e6
Showing with 61 additions and 52 deletions.
  1. +61 −52 src/main/clojure/clojure/tools/analyzer/passes/jvm/emit_form.clj
@@ -12,22 +12,23 @@
(defmulti -emit-form (fn [{:keys [op]} _] op))

(defn -emit-form*
[{:keys [form] :as ast} ops]
(let [expr (-emit-form ast ops)]
[{:keys [form] :as ast} opts]
(let [expr (-emit-form ast opts)]
(if-let [m (and (instance? clojure.lang.IObj expr)
(meta form))]
(with-meta expr (merge (meta expr) m))
expr)))

(defn emit-form
"Return the form represented by the given AST
Ops is a set of options, valid options are:
Opts is a set of options, valid options are:
* :hygienic
* :qualified-vars"
* :qualified-vars (DEPRECATED, use :qualified-symbols instead)
* :qualified-symbols"
([ast] (emit-form ast #{}))
([ast ops]
([ast opts]
(binding [default/-emit-form* -emit-form*]
(-emit-form* ast ops))))
(-emit-form* ast opts))))

(defn emit-hygienic-form
"Return an hygienic form represented by the given AST"
@@ -36,107 +37,115 @@
(-emit-form* ast #{:hygienic})))

(defmethod -emit-form :default
[ast ops]
(default/-emit-form ast ops))
[ast opts]
(default/-emit-form ast opts))

(defmethod -emit-form :const
[{:keys [type val] :as ast} opts]
(if (and (= type :class)
(:qualified-symbols opts))
(symbol (.getName ^Class val))
(default/-emit-form ast opts)))

(defmethod -emit-form :monitor-enter
[{:keys [target]} ops]
`(monitor-enter ~(-emit-form* target ops)))
[{:keys [target]} opts]
`(monitor-enter ~(-emit-form* target opts)))

(defmethod -emit-form :monitor-exit
[{:keys [target]} ops]
`(monitor-exit ~(-emit-form* target ops)))
[{:keys [target]} opts]
`(monitor-exit ~(-emit-form* target opts)))

(defmethod -emit-form :import
[{:keys [class]} ops]
[{:keys [class]} opts]
`(clojure.core/import* ~class))

(defmethod -emit-form :the-var
[{:keys [^clojure.lang.Var var]} ops]
[{:keys [^clojure.lang.Var var]} opts]
`(var ~(symbol (name (ns-name (.ns var))) (name (.sym var)))))

(defmethod -emit-form :method
[{:keys [params body this name form]} ops]
[{:keys [params body this name form]} opts]
(let [params (into [this] params)]
`(~(with-meta name (meta (first form)))
~(with-meta (mapv #(-emit-form* % ops) params)
~(with-meta (mapv #(-emit-form* % opts) params)
(meta (second form)))
~(-emit-form* body ops))))
~(-emit-form* body opts))))

(defn class->sym [class]
(symbol (.getName ^Class class)))

(defmethod -emit-form :catch
[{:keys [class local body]} ops]
`(catch ~(class->sym class) ~(-emit-form* local ops)
~(-emit-form* body ops)))
[{:keys [class local body]} opts]
`(catch ~(class->sym class) ~(-emit-form* local opts)
~(-emit-form* body opts)))

(defmethod -emit-form :deftype
[{:keys [name class-name fields interfaces methods]} ops]
`(deftype* ~name ~(class->sym class-name) ~(mapv #(-emit-form* % ops) fields)
[{:keys [name class-name fields interfaces methods]} opts]
`(deftype* ~name ~(class->sym class-name) ~(mapv #(-emit-form* % opts) fields)
:implements ~(mapv class->sym interfaces)
~@(mapv #(-emit-form* % ops) methods)))
~@(mapv #(-emit-form* % opts) methods)))

(defmethod -emit-form :reify
[{:keys [interfaces methods]} ops]
[{:keys [interfaces methods]} opts]
`(reify* ~(mapv class->sym (disj interfaces clojure.lang.IObj))
~@(mapv #(-emit-form* % ops) methods)))
~@(mapv #(-emit-form* % opts) methods)))

(defmethod -emit-form :case
[{:keys [test default tests thens shift mask low high switch-type test-type skip-check?]} ops]
`(case* ~(-emit-form* test ops)
[{:keys [test default tests thens shift mask low high switch-type test-type skip-check?]} opts]
`(case* ~(-emit-form* test opts)
~shift ~mask
~(-emit-form* default ops)
~(-emit-form* default opts)
~(apply sorted-map
(mapcat (fn [{:keys [hash test]} {:keys [then]}]
[hash [(-emit-form* test ops) (-emit-form* then ops)]])
[hash [(-emit-form* test opts) (-emit-form* then opts)]])
tests thens))
~switch-type ~test-type ~skip-check?))

(defmethod -emit-form :static-field
[{:keys [class field]} ops]
[{:keys [class field]} opts]
(symbol (.getName ^Class class) (name field)))

(defmethod -emit-form :static-call
[{:keys [class method args]} ops]
[{:keys [class method args]} opts]
`(~(symbol (.getName ^Class class) (name method))
~@(mapv #(-emit-form* % ops) args)))
~@(mapv #(-emit-form* % opts) args)))

(defmethod -emit-form :instance-field
[{:keys [instance field]} ops]
`(~(symbol (str ".-" (name field))) ~(-emit-form* instance ops)))
[{:keys [instance field]} opts]
`(~(symbol (str ".-" (name field))) ~(-emit-form* instance opts)))

(defmethod -emit-form :instance-call
[{:keys [instance method args]} ops]
`(~(symbol (str "." (name method))) ~(-emit-form* instance ops)
~@(mapv #(-emit-form* % ops) args)))
[{:keys [instance method args]} opts]
`(~(symbol (str "." (name method))) ~(-emit-form* instance opts)
~@(mapv #(-emit-form* % opts) args)))

(defmethod -emit-form :host-interop
[{:keys [target m-or-f]} ops]
`(~(symbol (str "." (name m-or-f))) ~(-emit-form* target ops)))
[{:keys [target m-or-f]} opts]
`(~(symbol (str "." (name m-or-f))) ~(-emit-form* target opts)))

(defmethod -emit-form :prim-invoke
[{:keys [fn args]} ops]
`(~(-emit-form* fn ops)
~@(mapv #(-emit-form* % ops) args)))
[{:keys [fn args]} opts]
`(~(-emit-form* fn opts)
~@(mapv #(-emit-form* % opts) args)))

(defmethod -emit-form :protocol-invoke
[{:keys [fn args]} ops]
`(~(-emit-form* fn ops)
~@(mapv #(-emit-form* % ops) args)))
[{:keys [fn args]} opts]
`(~(-emit-form* fn opts)
~@(mapv #(-emit-form* % opts) args)))

(defmethod -emit-form :keyword-invoke
[{:keys [fn args]} ops]
`(~(-emit-form* fn ops)
~@(mapv #(-emit-form* % ops) args)))
[{:keys [fn args]} opts]
`(~(-emit-form* fn opts)
~@(mapv #(-emit-form* % opts) args)))

(defmethod -emit-form :instance?
[{:keys [class target]} ops]
`(instance? ~class ~(-emit-form* target ops)))
[{:keys [class target]} opts]
`(instance? ~class ~(-emit-form* target opts)))

(defmethod -emit-form :var
[{:keys [form ^clojure.lang.Var var]} ops]
(if (:qualified-vars ops)
[{:keys [form ^clojure.lang.Var var]} opts]
(if (or (:qualified-symbols opts)
(:qualified-vars opts))
(with-meta (symbol (-> var .ns ns-name name) (-> var .sym name))
(meta form))
form))

0 comments on commit df55bf0

Please sign in to comment.
You can’t perform that action at this time.