Skip to content


Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

359 lines (311 sloc) 14.597 kb
; Copyright (c) Chris Houser, Sep 2008-Jan 2009. All rights reserved.
; 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.
; Reads Clojure code and emits equivalent JavaScript
(ns clojure.contrib.clojurescript
(:import (clojure.lang Compiler Compiler$C Compiler$BodyExpr
Compiler$DefExpr Compiler$InstanceMethodExpr))
(:require [ :as ds]))
(defn- vstr [v]
(let [sb (StringBuilder.)
lvl (fn lvl [v]
(doseq [i v]
(if (vector? i)
(lvl i)
(.append sb (str i)))))]
(lvl v)
(str sb)))
(def *debug-fn-names* true)
(def *debug-comments* true)
(def *eval-defmacro* true)
; used internally
(def *has-recur*)
(def *local-names* {})
(defmulti #^{:private true} tojs (fn [e ctx] (class e)))
(defn- fnmethod [fm maxm ctx]
(let [lm (into {} (for [[lb lb] (.locals fm)]
[lb (str (.name lb) "_" (.idx lb))]))
thisfn (first (filter #(= 0 (.idx %)) (keys lm)))
[body has-recur] (binding [*has-recur* false]
[(tojs (.body fm)
(merge-with merge ctx {:localmap lm}))
mparm (into {} (for [p (.reqParms maxm)] [(.idx p) p]))
inits (concat
(when has-recur ["_cnt" "_rtn"])
(vals (reduce dissoc lm
(conj (.reqParms fm) thisfn (.restParm fm))))
(when (:fnname ctx) [(str (lm thisfn) "=arguments.callee")])
(when (not= fm maxm)
(for [lb (.reqParms fm)
:when (not= (.name lb) (.name (mparm (.idx lb))))]
[(lm lb) "=arguments[" (dec (.idx lb)) "]"]))
(when-let [lb (.restParm fm)]
[(str (lm lb) "=clojure.JS.rest_args(this,arguments,"
(count (.reqParms fm)) ")")]))]
(.reqParms maxm)
(vstr [(when (seq inits)
[(apply vector "var " (interpose "," inits)) ";\n"])
(if has-recur
"\n}while(_cnt);return _rtn;"]
["return (" body ")"])])))
(defmethod tojs clojure.lang.Compiler$FnExpr [e ctx]
(let [maxm (or (.variadicMethod e)
(-> (into (sorted-map)
(for [fm (.methods e)
:when (not= fm (.variadicMethod e))]
[(count (.reqParms fm)) fm]))
last val))
manym (< 1 (count (.methods e)))
newctx (assoc ctx :fnname (.thisName e))
[methods local-names] (binding [*local-names* *local-names*]
[(into {} (for [fm (.methods e)]
[fm (fnmethod fm maxm newctx)]))
(vstr [(when (.variadicMethod e)
["clojure.JS.variadic(" (count (.reqParms maxm)) ","])
(when *debug-fn-names*
[" __" (.replaceAll (.name e) "[\\W_]+" "_")])
(vec (interpose "," (for [lb (.reqParms maxm)]
[(.name lb) "_" (.idx lb)])))
;"\n//" (vec (interpose "," (vals local-names))) "\n"
(when manym
(vec (for [[fm body] methods :when (not= fm maxm)]
["\ncase " (count (.reqParms fm)) ":" body]))
(methods maxm) "})"
(when (.variadicMethod e)
(defmethod tojs clojure.lang.Compiler$BodyExpr [e ctx]
(apply str (interpose ",\n" (map #(tojs % ctx) (.exprs e)))))
(defmethod tojs clojure.lang.Compiler$LetExpr [e ctx]
(let [inits (vec (interpose ",\n" (for [bi (.bindingInits e)]
["(" ((:localmap ctx) (.binding bi))
"=" (tojs (.init bi) ctx) ")"])))]
(if (.isLoop e)
(binding [*has-recur* false]
(vstr ["((function"
(when *debug-fn-names* " __loop")
"(){var _rtn,_cnt;"
inits ";"
"do{_cnt=0;\n_rtn=" (tojs (.body e) ctx)
"}while(_cnt);return _rtn;})())"]))
(vstr ["(" inits ",\n" (tojs (.body e) ctx) ")"]))))
(defmethod tojs clojure.lang.Compiler$VectorExpr [e ctx]
(vstr ["clojure.JS.lit_vector(["
(vec (interpose "," (map #(tojs % ctx) (.args e))))
(defn- const-str [c]
(or (instance? Character c)
(string? c)) (pr-str (str c))
(keyword? c) (str "clojure.core.keyword(\"" (namespace c) "\",\"" (name c) "\")")
(symbol? c) (str "clojure.core.symbol(\"" c "\")")
(class? c) (.getCanonicalName c)
(list? c) (vstr ["clojure.JS.lit_list(["
(vec (interpose "," (map const-str c)))
(fn? c) (str \" c \")
(instance? java.util.regex.Pattern c) (str "(/"
(.replace (str c) "/" "\\/")
:else (str "(" c ")")))
(defmethod tojs clojure.lang.Compiler$ConstantExpr [e ctx]
(const-str (.v e)))
(def js-reserved '#{import boolean short byte char class})
(defn- var-munge [x]
(let [n (-> x str Compiler/munge (.replace "." "_DOT_"))]
(if (js-reserved (symbol n))
(str n "_")
(defn- var-parts [e]
(let [{:keys [name ns]} (meta (.var e))]
[(Compiler/munge (str (.getName ns))) (var-munge name)]))
(defmethod tojs clojure.lang.Compiler$UnresolvedVarExpr [e ctx]
(vstr ["clojure.JS.resolveVar(\""
(var-munge (name (.symbol e))) "\","
(Compiler/munge (name (.name *ns*))) ")"]))
(defmethod tojs clojure.lang.Compiler$VarExpr [e ctx]
(let [[vns vname] (var-parts e)]
(if (and (= vns "clojurescript.js") (#{"this"} vname))
(str vns "." vname))))
(defmethod tojs clojure.lang.Compiler$TheVarExpr [e ctx]
(let [[vns vname] (var-parts e)]
(str vns "._var_" vname)))
(defmethod tojs clojure.lang.Compiler$AssignExpr [e ctx]
(let [target (.target e)]
(if (instance? clojure.lang.Compiler$InstanceFieldExpr target)
(vstr ["(" (tojs (.target target) ctx) "."
(var-munge (.fieldName target)) "=" (tojs (.val e) ctx) ")"])
(let [[vns vname] (var-parts target)]
(str vns "._var_" vname ".set(" (tojs (.val e) ctx) ")")))))
(defmethod tojs clojure.lang.Compiler$DefExpr [e ctx]
(let [[vns vname] (var-parts e)]
(str "clojure.JS.def(" vns ",\"" vname "\"," (tojs (.init e) ctx) ")")))
(defmethod tojs clojure.lang.Compiler$InvokeExpr [e ctx]
(vstr [(tojs (.fexpr e) ctx)
(vec (interpose "," (map #(tojs % ctx) (.args e))))
(defmethod tojs clojure.lang.Compiler$LocalBindingExpr [e ctx]
(let [local-name ((:localmap ctx) (.b e))]
(set! *local-names* (assoc *local-names* (.b e) local-name))
(defmethod tojs clojure.lang.Compiler$NilExpr [e ctx]
(defmethod tojs clojure.lang.Compiler$EmptyExpr [e ctx]
(str (.getCanonicalName (class (.coll e))) ".EMPTY"))
(defmethod tojs clojure.lang.Compiler$StringExpr [e ctx]
(const-str (.str e)))
(defmethod tojs clojure.lang.Compiler$KeywordExpr [e ctx]
(const-str (.k e)))
(defmethod tojs clojure.lang.Compiler$StaticFieldExpr [e ctx]
(str "clojure.JS.getOrRun(" (.getCanonicalName (.c e)) ",\""
(var-munge (.fieldName e)) "\")"))
(defmethod tojs clojure.lang.Compiler$StaticMethodExpr [e ctx]
(vstr [(.getCanonicalName (.c e)) "." (.methodName e) "("
(vec (interpose "," (map #(tojs % ctx) (.args e))))
(defmethod tojs clojure.lang.Compiler$NewExpr [e ctx]
(vstr ["(new " (.getCanonicalName (.c e)) "("
(vec (interpose "," (map #(tojs % ctx) (.args e))))
(defmethod tojs clojure.lang.Compiler$InstanceMethodExpr [e ctx]
(vstr ["(" (tojs (.target e) ctx) ")." (var-munge (.methodName e))
"(" (vec (interpose "," (map #(tojs % ctx) (.args e)))) ")"]))
(defmethod tojs clojure.lang.Compiler$InstanceFieldExpr [e ctx]
(vstr ["clojure.JS.getOrRun(" (tojs (.target e) ctx) ",\""
(var-munge (.fieldName e)) "\")"]))
(defmethod tojs clojure.lang.Compiler$IfExpr [e ctx]
(str "((" (tojs (.testExpr e) ctx)
")?(" (tojs (.thenExpr e) ctx)
"):(" (tojs (.elseExpr e) ctx) "))"))
(defmethod tojs clojure.lang.Compiler$RecurExpr [e ctx]
(set! *has-recur* true)
(vstr ["(_cnt=1,_rtn=["
(vec (interpose "," (map #(tojs % ctx) (.args e))))
(vec (map #(str "," ((:localmap ctx) %1) "=_rtn[" %2 "]")
(.loopLocals e) (iterate inc 0)))
(defmethod tojs clojure.lang.Compiler$MapExpr [e ctx]
(vstr ["clojure.core.hash_map("
(vec (interpose "," (map #(tojs % ctx) (.keyvals e))))
(defmethod tojs clojure.lang.Compiler$SetExpr [e ctx]
(vstr ["clojure.core.hash_set("
(vec (interpose "," (map #(tojs % ctx) (.keys e))))
(defmethod tojs clojure.lang.Compiler$BooleanExpr [e ctx]
(if (.val e) "true" "false"))
(defmethod tojs clojure.lang.Compiler$ThrowExpr [e ctx]
(vstr ["(function"
(when *debug-fn-names* " __throw")
"(){throw " (tojs (.excExpr e) ctx) "})()"]))
(defmethod tojs clojure.lang.Compiler$TryExpr [e ctx]
(vstr ["(function"
(when *debug-fn-names* " __try")
"(){try{var _rtn=("
(tojs (.tryExpr e) ctx)
(when (seq (.catchExprs e))
(when (not= 1 (count (.catchExprs e)))
(throw (Exception. "tojs only supports one catch clause per try")))
(let [cc (first (.catchExprs e))]
["\ncatch(" ((:localmap ctx) (.lb cc)) "){_rtn="
(tojs (.handler cc) ctx)
(when (.finallyExpr e)
(tojs (.finallyExpr e) ctx)
"return _rtn})()"]))
(defmulti toclj class)
(defmethod toclj clojure.lang.Compiler$KeywordExpr [e] (.k e))
(defmethod toclj clojure.lang.Compiler$StringExpr [e] (.str e))
(defmethod toclj clojure.lang.Compiler$ConstantExpr [e] (.v e))
(def skip-def '#{;-- implemented directly in clj.js
seq instance? assoc apply refer first rest import
hash-map count find keys vals get class contains?
print-method class? number? string? integer? nth
to-array cons keyword symbol load
;-- not supported yet
make-array to-array-2d re-pattern re-matcher re-groups
re-seq re-matches re-find format
;-- macros defined without using defmacro
let loop fn defn defmacro
;-- will probably never be supported in clojurescript
eval resolve ns-resolve await await-for macroexpand
macroexpand-1 load-reader load-string special-symbol?
bigint bigdec floats doubles ints longs float-array
double-array int-array long-array aset-int
aset-long aset-boolean aset-float aset-double
aset-short aset-char aset-byte slurp seque
decimal? float? pmap primitives-classnames})
(def skip-method #{"java.lang.Class"})
(defn formtojs [f]
(when-not (and (coll? f) (= 'definline (first f)))
(let [expr (binding [*allow-unresolved-vars* true
*compiler-analyze-only* true
*private-compiler-loader* (clojure.lang.RT/baseLoader)]
(Compiler/analyze Compiler$C/STATEMENT `((fn [] ~f))))
mainexpr (-> expr .fexpr .methods first .body .exprs first)
defmacro? (and (instance? Compiler$BodyExpr mainexpr)
(instance? Compiler$DefExpr (first (.exprs mainexpr)))
(instance? Compiler$InstanceMethodExpr (second (.exprs mainexpr)))
(= "setMacro" (.methodName (second (.exprs mainexpr)))))]
(if defmacro?
(when *eval-defmacro*
(eval f)
(when-not (or (and (instance? Compiler$DefExpr mainexpr)
(skip-def (:name (meta (.var mainexpr)))))
(and (instance? Compiler$InstanceMethodExpr mainexpr)
(or (= "setMacro" (.methodName mainexpr))
(and (= "addMethod" (.methodName mainexpr))
(skip-method (tojs (first (.args mainexpr))
(and (instance? Compiler$BodyExpr mainexpr)
(instance? Compiler$DefExpr (first (.exprs mainexpr)))
(instance? Compiler$InstanceMethodExpr (second (.exprs mainexpr)))
(= "setMacro" (.methodName (second (.exprs mainexpr))))))
(tojs expr {:localmap {}}))))))
(defn filetojs [filename & optseq]
(let [reader ( (ds/reader filename))
opts (apply array-map optseq)]
(binding [*ns* (create-ns 'user)
*debug-fn-names* (:debug-fn-names opts true)
*debug-comments* (:debug-comments opts true)
*eval-defmacro* (:eval-defmacro opts true)]
(loop []
(let [f (read reader false reader false)]
(when-not (identical? f reader)
(if-let [js (formtojs f)]
(when *debug-comments*
(println "\n//======")
(print "//")
(prn f)
(println "//---"))
(println (str js ";"))
(when (and (coll? f)
(or (= 'ns (first f))
(= 'in-ns (first f))))
(eval f)))
(when *debug-comments*
(print "// Skipping: ")
(prn f)))
Jump to Line
Something went wrong with that request. Please try again.