diff options
Diffstat (limited to 'clojurescript/tojs.clj')
| -rw-r--r-- | clojurescript/tojs.clj | 439 |
1 files changed, 0 insertions, 439 deletions
diff --git a/clojurescript/tojs.clj b/clojurescript/tojs.clj deleted file mode 100644 index 8c9f9e4d..00000000 --- a/clojurescript/tojs.clj +++ /dev/null @@ -1,439 +0,0 @@ -; Copyright (c) Chris Houser, Sep 2008. All rights reserved. -; The use and distribution terms for this software are covered by the -; Common Public License 1.0 (http://opensource.org/licenses/cpl.php) -; which can be found in the file CPL.TXT 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 clojurescript.tojs - (:import (clojure.lang Compiler Compiler$C Compiler$BodyExpr - Compiler$DefExpr Compiler$InstanceMethodExpr) - (java.io BufferedReader InputStreamReader StringReader PrintWriter) - (java.net URLDecoder)) - (:use [clojure.contrib.command-line :only (with-command-line)]) - (:require (clojure.contrib [duck-streams :as ds] - [seq-utils :as su]))) - -(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 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})) - *has-recur*]) - 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 - ["do{_cnt=0;_rtn=" - body - "\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)])) - *local-names*])] - (vstr [(when (.variadicMethod e) - ["clojure.JS.variadic(" (count (.reqParms maxm)) ","]) - "(function" - (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 - ["switch(arguments.length){" - (vec (for [[fm body] methods :when (not= fm maxm)] - ["\ncase " (count (.reqParms fm)) ":" body])) - "}"]) - "\n" - (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] - (cond - (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 "_") - n))) - -(defn var-parts [e] - (let [{:keys [name ns]} ^(.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)) - 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) - ".apply(null,[" - (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)) - local-name)) - -(defmethod tojs clojure.lang.Compiler$NilExpr [e ctx] - "null") - -(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) - ["\nfinally{" - (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))) - (binding [*allow-unresolved-vars* true - *private-compiler-loader* (clojure.lang.RT/makeClassLoader)] - (let [expr (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) - nil) - (when-not (or (and (instance? Compiler$DefExpr mainexpr) - (skip-def (:name ^(.var mainexpr)))) - (and (instance? Compiler$InstanceMethodExpr mainexpr) - (or (= "setMacro" (.methodName mainexpr)) - (and (= "addMethod" (.methodName mainexpr)) - (skip-method (tojs (first (.args mainexpr)) - nil))))) - (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] - (let [reader (java.io.PushbackReader. (ds/reader filename))] - (binding [*ns* (create-ns 'user)] - (loop [] - (let [f (read reader false reader false)] - (when-not (identical? f reader) - (if-let [js (formtojs f)] - (do - (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))) - (recur))))))) - -(defn simple-tests [] - (println (formtojs - '(defn foo - ([a b c & d] (prn 3 a b c)) - ([c] - ;(String/asd "hello") - ;(.foo 55) - (let [[a b] [1 2]] - (prn a b c) - "hi"))))) - - (println (formtojs - '(defn foo [a] - (prn "hi") - (let [a 5] - (let [a 10] - (prn "yo") - (prn a)) - (prn a)) - (prn a)))) - - (println (formtojs - '(defn x [] (conj [] (loop [i 5] (if (pos? i) (recur (- i 2)) i)))))) - - ;(println (formtojs '(binding [*out* 5] (set! *out* 10)))) - (println (formtojs '(.replace "a/b/c" "/" "."))) - (println (formtojs '(.getName ":foo"))) - (println (formtojs '(list '(1 "str" 'sym :key) 4 "str2" 6 #{:set 9 8}))) - (println (formtojs '(fn forever[] (forever)))) - (println (formtojs '(fn forever[] (loop [] (recur)))))) - -(defn start-server [port] - ;(println "Opening port" port) - (loop [server (java.net.ServerSocket. port)] ; should bind only to 127.0.0.1 - (send-off (agent (.accept server)) - (fn [socket] - (with-open [socket socket] - (binding [*debug-fn-names* false - *debug-comments* false - *eval-defmacro* false - *out* (-> socket .getOutputStream ds/writer)] - (try - (print "HTTP/1.0 200 OK\nContent-Type: text/javascript\n\n") - (let [line1 (-> socket .getInputStream ds/reader .readLine) - [_ url] (re-find #"^GET /\?(.*?) HTTP" line1) - codestr (URLDecoder/decode url) - js (with-out-str (filetojs (StringReader. codestr)))] - (println "jsrepl.state('compiled');try{") - (println "jsrepl.lastval=" js ) - (println "jsrepl.state('done');}catch(e){jsrepl.err(e)};")) - (catch Exception e - (if (= (.getMessage e) "EOF while reading") - (println "jsrepl.state('incomplete');") - (let [trace (with-out-str - (.printStackTrace e (PrintWriter. *out*)))] - (println "jsrepl.state('error',\"" - (.replace trace "\n" "\\n") "\");"))))))))) - (recur server))) - -(defn mkcore [] - (binding [*out* (ds/writer "core.js")] - (doseq [file ["clojure/core.clj" "clojure/core-print.clj"]] - (filetojs (.getResourceAsStream (clojure.lang.RT/baseLoader) file))))) - -(defn -main [& args] - (with-command-line args - "tojs -- Compile ClojureScript to JavaScript" - [[simple? "Runs some simple built-in tests"] - [serve "Starts a repl server on the given port" 8081] - [mkcore? "Generates a core.js file"] - [v? "Includes extra fn names and comments in js"] - filenames] - (binding [*debug-fn-names* v? *debug-comments* v?] - (cond - simple? (simple-tests) - serve (start-server (Integer/parseInt serve)) - mkcore? (mkcore) - :else (doseq [filename filenames] - (filetojs filename)))))) - -;(when-not *compile-files* (apply -main *command-line-args*)) |