Skip to content


Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

186 lines (150 sloc) 5.606 kb
;; Copyright (c) Nicola Mometto, Rich Hickey & contributors.
;; The use and distribution terms for this software are covered by the
;; Eclipse Public License 1.0 (
;; which can be found in the file epl-v10.html at the root of this distribution.
;; By using this software in any fashion, you are agreeing to be bound by
;; the terms of this license.
;; You must not remove this notice, or any other, from this software.
(defmulti -emit-form (fn [{:keys [op]} _] op))
(defn ^:dynamic -emit-form*
"Extension point for custom emit-form implementations, should be rebound
to a multimethod with custom emit-form :ops."
[{:keys [form] :as ast} ops]
(let [expr (-emit-form ast ops)]
(if-let [m (and (instance? clojure.lang.IObj expr)
(meta form))]
(with-meta expr (merge (meta expr) m))
(defn emit-form
"Return the form represented by the given AST.
Ops is a set of options, valid options are:
* :hygienic"
([ast] (emit-form ast #{}))
([ast ops] (-emit-form* ast ops)))
(defn emit-hygienic-form
"Return an hygienic form represented by the given AST"
(-emit-form* ast #{:hygienic}))
(defmethod -emit-form :maybe-class
[{:keys [class]} ops]
(defmethod -emit-form :maybe-host-form
[{:keys [class field]} ops]
(symbol (name class) (name field)))
(defmethod -emit-form :host-call
[{:keys [target method args]} ops]
(list '. (-emit-form* target ops)
(list* method (mapv #(-emit-form* % ops) args))))
(defmethod -emit-form :host-field
[{:keys [target field]} ops]
(list (symbol (str ".-" (name field)))
(-emit-form* target ops)))
(defmethod -emit-form :host-interop
[{:keys [target m-or-f]} ops]
(list '. (-emit-form* target ops) m-or-f))
(defmethod -emit-form :local
[{:keys [name form]} ops]
(if (:hygienic ops) (with-meta name (meta form)) form))
(defmethod -emit-form :binding
[{:keys [name form]} ops]
(if (:hygienic ops) (with-meta name (meta form)) form))
(defmethod -emit-form :var
[{:keys [form]} ops]
(defn emit-bindings [bindings ops]
(mapcat (fn [{:keys [name form init]}]
[(if (:hygienic ops) name form) (-emit-form* init ops)])
(defmethod -emit-form :letfn
[{:keys [bindings body]} ops]
`(letfn* [~@(emit-bindings bindings ops)]
~(-emit-form* body ops)))
(defmethod -emit-form :let
[{:keys [bindings body]} ops]
`(let* [~@(emit-bindings bindings ops)]
~(-emit-form* body ops)))
(defmethod -emit-form :loop
[{:keys [bindings body]} ops]
`(loop* [~@(emit-bindings bindings ops)]
~(-emit-form* body ops)))
(defmethod -emit-form :const
[{:keys [form]} _]
(defmethod -emit-form :quote
[{:keys [expr]} ops]
(list 'quote (-emit-form* expr ops)))
(defmethod -emit-form :vector
[{:keys [items]} ops]
(mapv #(-emit-form* % ops) items))
(defmethod -emit-form :set
[{:keys [items]} ops]
(set (mapv #(-emit-form* % ops) items)))
(defmethod -emit-form :map
[{:keys [keys vals]} ops]
(apply hash-map (interleave (mapv #(-emit-form* % ops) keys)
(mapv #(-emit-form* % ops) vals))))
(defmethod -emit-form :with-meta
[{:keys [expr meta]} ops]
(with-meta (-emit-form* expr ops)
(-emit-form* meta ops)))
(defmethod -emit-form :do
[{:keys [ret statements body?]} ops]
(if (and body? (empty? statements))
(-emit-form* ret ops)
`(do ~@(mapv #(-emit-form* % ops) statements)
~(-emit-form* ret ops))))
(defmethod -emit-form :if
[{:keys [test then else]} ops]
`(if ~(-emit-form* test ops)
~(-emit-form* then ops)
~@(when-not (nil? (:form else))
[(-emit-form* else ops)])))
(defmethod -emit-form :new
[{:keys [class args]} ops]
`(new ~class ~@(mapv #(-emit-form* % ops) args)))
(defmethod -emit-form :set!
[{:keys [target val]} ops]
`(set! ~(-emit-form* target ops) ~(-emit-form* val ops)))
(defmethod -emit-form :recur
[{:keys [exprs]} ops]
`(recur ~@(mapv #(-emit-form* % ops) exprs)))
(defmethod -emit-form :fn-method
[{:keys [variadic? params body form]} ops]
(let [params-form (mapv #(-emit-form* % ops) params)]
(if variadic? (into (pop params-form)
(conj '[&] (peek params-form)))
(meta (first form)))
~(-emit-form* body ops))))
(defmethod -emit-form :fn
[{:keys [local methods]} ops]
`(fn* ~@(when local [(-emit-form* local ops)])
~@(mapv #(-emit-form* % ops) methods)))
(defmethod -emit-form :def
[{:keys [name doc init]} ops]
(let [name (if-let [arglists (:arglists (meta name))]
(with-meta name (assoc (meta name) :arglists (list 'quote arglists)))
`(def ~name ~@(when doc [doc]) ~@(when init [(-emit-form* init ops)]))))
(defmethod -emit-form :invoke
[{:keys [fn args meta]} ops]
(let [expr `(~(-emit-form* fn ops)
~@(mapv #(-emit-form* % ops) args))]
(if meta
(with-meta expr meta)
(defmethod -emit-form :try
[{:keys [body catches finally]} ops]
`(try ~(-emit-form* body ops)
~@(mapv #(-emit-form* % ops) catches)
~@(when finally
[`(finally ~(-emit-form* finally ops))])))
(defmethod -emit-form :catch
[{:keys [class local body]} ops]
`(catch ~class ~(-emit-form* local ops)
~(-emit-form* body ops)))
(defmethod -emit-form :throw
[{:keys [exception]} ops]
`(throw ~(-emit-form* exception ops)))
Jump to Line
Something went wrong with that request. Please try again.