Skip to content

Instantly share code, notes, and snippets.

@swannodette

swannodette/cljs-compiler.patch

Forked from kanaka/cljs-compiler.patch
Created November 19, 2012 14:06
Show Gist options
  • Save swannodette/4110826 to your computer and use it in GitHub Desktop.
Save swannodette/4110826 to your computer and use it in GitHub Desktop.
Download ZIP
Raw
cljs-compiler.patch
--- src/clj/cljs/analyzer.clj 2012-11-17 01:01:55.712323358 -0500
+++ src/cljs/cljs/analyzer.cljs 2012-11-17 11:51:47.030558150 -0500
@@ -6,14 +6,23 @@
; the terms of this license.
; You must not remove this notice, or any other, from this software.
-(set! *warn-on-reflection* true)
+;; (set! *warn-on-reflection* true)
(ns cljs.analyzer
(:refer-clojure :exclude [macroexpand-1])
- (:require [clojure.java.io :as io]
+ (:require ;; [clojure.java.io :as io]
[clojure.string :as string]
- [cljs.tagged-literals :as tags])
- (:import java.lang.StringBuilder))
+ ;;[cljs.tagged-literals :as tags]
+ )
+ (:use-macros [cljs.analyzer-macros :only [disallowing-recur]])
+ ;;(:import java.lang.StringBuilder)
+ )
+
+;; Stubs just to make it work
+;;(defn create-ns [ns-sym] nil)
+(defn create-ns [ns-sym] #_(.log js/console ns-sym)
+ (js/eval (str "try { " ns-sym "; } catch (e) { " ns-sym " = {}; }")))
+
(declare resolve-var)
(declare resolve-existing-var)
@@ -28,8 +37,10 @@
(def ^:dynamic *reader-ns-name* (gensym))
(def ^:dynamic *reader-ns* (create-ns *reader-ns-name*))
-(defonce namespaces (atom '{cljs.core {:name cljs.core}
- cljs.user {:name cljs.user}}))
+(def namespaces (atom '{cljs.core {:name cljs.core}
+ cljs.user {:name cljs.user}}))
(defn reset-namespaces! []
(reset! namespaces
@@ -63,29 +74,29 @@
(load *cljs-macros-path*)
(load-file *cljs-macros-path*))))
-(defmacro with-core-macros
- [path & body]
- `(do
- (when (not= *cljs-macros-path* ~path)
- (reset! -cljs-macros-loaded false))
- (binding [*cljs-macros-path* ~path]
- ~@body)))
-
-(defmacro with-core-macros-file
- [path & body]
- `(do
- (when (not= *cljs-macros-path* ~path)
- (reset! -cljs-macros-loaded false))
- (binding [*cljs-macros-path* ~path
- *cljs-macros-is-classpath* false]
- ~@body)))
(defn empty-env []
{:ns (@namespaces *cljs-ns*) :context :statement :locals {}})
-(defmacro ^:private debug-prn
- [& args]
- `(.println System/err (str ~@args)))
(defn warning [env s]
(binding [*out* *err*]
@@ -128,7 +139,7 @@
{:name (symbol (str full-ns) (str (name sym)))
:ns full-ns}))
- (.contains s ".")
+ (>= (.indexOf s ".") 0)
(let [idx (.indexOf s ".")
prefix (symbol (subs s 0 idx))
suffix (subs s (inc idx))
@@ -173,7 +184,7 @@
ns (if (= "clojure.core" ns) "cljs.core" ns)]
{:name (symbol (str (resolve-ns-alias env ns)) (name sym))})
- (.contains s ".")
+ (>= (.indexOf s ".") 0)
(let [idx (.indexOf s ".")
prefix (symbol (subs s 0 idx))
suffix (subs s idx)
@@ -213,8 +224,8 @@
(def ^:dynamic *recur-frames* nil)
(def ^:dynamic *loop-lets* nil)
-(defmacro disallowing-recur [& body]
- `(binding [*recur-frames* (cons nil *recur-frames*)] ~@body))
(defn analyze-keyword
[env sym]
@@ -472,7 +483,7 @@
bindings (seq (partition 2 bindings))]
(if-let [[name init] (first bindings)]
(do
- (assert (not (or (namespace name) (.contains (str name) "."))) (str "Invalid local name: " name))
+ (assert (not (or (namespace name) (>= (.indexOf (str name) ".") 0))) (str "Invalid local name: " name))
(let [init-expr (analyze env init)
be {:name name
:init init-expr
@@ -589,12 +600,12 @@
(declare analyze-file)
-(defn analyze-deps [deps]
- (doseq [dep deps]
- (when-not (:defs (@namespaces dep))
- (let [relpath (ns->relpath dep)]
- (when (io/resource relpath)
- (analyze-file relpath))))))
(defmethod parse 'ns
[_ env [_ name & args :as form] _]
@@ -666,7 +677,9 @@
(apply merge-with merge m (map (spec-parsers k) libs)))
{} (remove (fn [[r]] (= r :refer-clojure)) args))]
(when (seq @deps)
- (analyze-deps @deps))
+ (println "**** Skipping analyze-deps ****")
+ )
(set! *cljs-ns* name)
(load-core)
(doseq [nsym (concat (vals requires-macros) (vals uses-macros))]
@@ -856,7 +869,7 @@
(if-let [nstr (namespace sym)]
(when-let [ns (cond
(= "clojure.core" nstr) (find-ns 'cljs.core)
- (.contains nstr ".") (find-ns (symbol nstr))
+ (>= (.indexOf nstr ".") 0) (find-ns (symbol nstr))
:else
(-> env :ns :requires-macros (get (symbol nstr))))]
(.findInternedVar ^clojure.lang.Namespace ns (symbol (name sym))))
@@ -866,6 +879,7 @@
(when (and mvar (.isMacro ^clojure.lang.Var mvar))
@mvar)))
+;; JOELM: we will need this eventually
(defn macroexpand-1 [env form]
(let [op (first form)]
(if (specials op)
@@ -885,6 +899,8 @@
:else form))
form)))))
+(defn macroexpand-1 [env form] form)
+
(defn analyze-seq
[env form name]
(let [env (assoc env :line
@@ -944,10 +960,10 @@
facilitate code walking without knowing the details of the op set."
([env form] (analyze env form nil))
([env form name]
- (let [form (if (instance? clojure.lang.LazySeq form)
+ (let [form (if (instance? cljs.core.LazySeq form)
(or (seq form) ())
form)]
- (load-core)
+ ;;(load-core)
(cond
(symbol? form) (analyze-symbol env form)
(and (seq? form) (seq form)) (analyze-seq env form name)
@@ -957,19 +973,19 @@
(keyword? form) (analyze-keyword env form)
:else {:op :constant :env env :form form}))))
-(defn analyze-file
- [^String f]
- (let [res (if (re-find #"^file://" f) (java.net.URL. f) (io/resource f))]
- (assert res (str "Can't find " f " in classpath"))
- (binding [*cljs-ns* 'cljs.user
- *cljs-file* (.getPath ^java.net.URL res)
- *ns* *reader-ns*]
- (with-open [r (io/reader res)]
- (let [env (empty-env)
- pbr (clojure.lang.LineNumberingPushbackReader. r)
- eof (Object.)]
- (loop [r (read pbr false eof false)]
- (let [env (assoc env :ns (get-namespace *cljs-ns*))]
- (when-not (identical? eof r)
- (analyze env r)
- (recur (read pbr false eof false))))))))))
--- src/clj/cljs/compiler.clj 2012-11-17 01:01:55.712323358 -0500
+++ src/cljs/cljs/compiler.cljs 2012-11-17 12:20:51.318479897 -0500
@@ -6,15 +6,17 @@
; the terms of this license.
; You must not remove this notice, or any other, from this software.
-(set! *warn-on-reflection* true)
+;; (set! *warn-on-reflection* true)
(ns cljs.compiler
(:refer-clojure :exclude [munge macroexpand-1])
- (:require [clojure.java.io :as io]
+ (:require ;; [clojure.java.io :as io]
[clojure.string :as string]
- [cljs.tagged-literals :as tags]
+ ;; [cljs.tagged-literals :as tags]
[cljs.analyzer :as ana])
- (:import java.lang.StringBuilder))
+ (:use-macros [cljs.compiler-macros :only [emit-wrap]])
+ ;;(:import java.lang.StringBuilder)
+ )
(declare munge)
@@ -37,7 +39,35 @@
(def ^:dynamic *lexical-renames* {})
(def cljs-reserved-file-names #{"deps.cljs"})
-(defonce ns-first-segments (atom '#{"cljs" "clojure"}))
+(def ns-first-segments (atom '#{"cljs" "clojure"}))
+
+
+(def CHAR_MAP {"-", "_",
+ ;".", "_DOT_",
+ ":", "_COLON_",
+ "+", "_PLUS_",
+ ">", "_GT_",
+ "<", "_LT_",
+ "=", "_EQ_",
+ "~", "_TILDE_",
+ "!", "_BANG_",
+ "@", "_CIRCA_",
+ "#", "_SHARP_",
+ "'", "_SINGLEQUOTE_",
+ "\"", "_DOUBLEQUOTE_",
+ "%", "_PERCENT_",
+ "^", "_CARET_",
+ "&", "_AMPERSAND_",
+ "*", "_STAR_",
+ "|", "_BAR_",
+ "{", "_LBRACE_",
+ "}", "_RBRACE_",
+ "[", "_LBRACK_",
+ "]", "_RBRACK_",
+ "/", "_SLASH_",
+ "\\", "_BSLASH_",
+ "?", "_QMARK_"})
(defn munge
([s] (munge s js-reserved))
@@ -50,7 +80,7 @@
shadow (recur (inc d) shadow)
(@ns-first-segments (str name)) (inc d)
:else d))
- renamed (*lexical-renames* (System/identityHashCode s))
+ renamed (*lexical-renames* (hash s))
munged-name (munge (cond field (str "self__." name)
renamed renamed
:else name)
@@ -59,10 +89,10 @@
munged-name
(symbol (str munged-name "__$" depth))))
; String munging
- (let [ss (string/replace (str s) #"\/(.)" ".$1") ; Division is special
- ss (apply str (map #(if (reserved %) (str % "$") %)
- (string/split ss #"(?<=\.)|(?=\.)")))
- ms (clojure.lang.Compiler/munge ss)]
+ (let [ss (string/replace (str s) #"/(.)" ".$1") ; Division is special
+ ss (string/join "." (map #(if (reserved %) (str % "$") %)
+ (string/split ss #"[.]")))
+ ms (apply str (map #(get CHAR_MAP % %) ss))]
(if (symbol? s)
(symbol ms)
ms)))))
@@ -71,7 +101,7 @@
(interpose "," xs))
(defn- escape-char [^Character c]
- (let [cp (.hashCode c)]
+ (let [cp (.charCodeAt c 0)]
(case cp
; Handle printable escapes before ASCII
34 "\\\""
@@ -87,10 +117,7 @@
(format "\\u%04X" cp))))) ; Any other character is Unicode
(defn- escape-string [^CharSequence s]
- (let [sb (StringBuilder. (count s))]
- (doseq [c s]
- (.append sb (escape-char c)))
- (.toString sb)))
+ (apply str (map #(escape-char %) s)))
(defn- wrap-in-double-quotes [x]
(str \" x \"))
@@ -135,76 +162,86 @@
(swap! *emitted-provides* conj sym)
(emitln "goog.provide('" (munge sym) "');")))
-(defmulti emit-constant class)
-(defmethod emit-constant nil [x] (emits "null"))
-(defmethod emit-constant Long [x] (emits x))
-(defmethod emit-constant Integer [x] (emits x)) ; reader puts Integers in metadata
-(defmethod emit-constant Double [x] (emits x))
-(defmethod emit-constant String [x]
- (emits (wrap-in-double-quotes (escape-string x))))
-(defmethod emit-constant Boolean [x] (emits (if x "true" "false")))
-(defmethod emit-constant Character [x]
- (emits (wrap-in-double-quotes (escape-char x))))
-
-(defmethod emit-constant java.util.regex.Pattern [x]
- (let [[_ flags pattern] (re-find #"^(?:\(\?([idmsux]*)\))?(.*)" (str x))]
- (emits \/ (.replaceAll (re-matcher #"/" pattern) "\\\\/") \/ flags)))
-(defmethod emit-constant clojure.lang.Keyword [x]
+(defn- emit-meta-constant [x & body]
+ (if (meta x)
+ (do
+ (emits "cljs.core.with_meta(" body ",")
+ (emit-constant (meta x))
+ (emits ")"))
+ (emits body)))
+
+(defn emit-constant-keyword [x]
(emits \" "\\uFDD0" \'
(if (namespace x)
(str (namespace x) "/") "")
(name x)
\"))
-(defmethod emit-constant clojure.lang.Symbol [x]
+(defn emit-constant-symbol [x]
(emits \" "\\uFDD1" \'
(if (namespace x)
(str (namespace x) "/") "")
(name x)
\"))
-(defn- emit-meta-constant [x & body]
- (if (meta x)
- (do
- (emits "cljs.core.with_meta(" body ",")
- (emit-constant (meta x))
- (emits ")"))
- (emits body)))
-
-(defmethod emit-constant clojure.lang.PersistentList$EmptyList [x]
- (emit-meta-constant x "cljs.core.List.EMPTY"))
-
-(defmethod emit-constant clojure.lang.PersistentList [x]
- (emit-meta-constant x
- (concat ["cljs.core.list("]
- (comma-sep (map #(fn [] (emit-constant %)) x))
- [")"])))
-
-(defmethod emit-constant clojure.lang.Cons [x]
- (emit-meta-constant x
- (concat ["cljs.core.list("]
- (comma-sep (map #(fn [] (emit-constant %)) x))
- [")"])))
-
-(defmethod emit-constant clojure.lang.IPersistentVector [x]
- (emit-meta-constant x
- (concat ["cljs.core.vec(["]
- (comma-sep (map #(fn [] (emit-constant %)) x))
- ["])"])))
-
-(defmethod emit-constant clojure.lang.IPersistentMap [x]
- (emit-meta-constant x
- (concat ["cljs.core.hash_map("]
- (comma-sep (map #(fn [] (emit-constant %))
- (apply concat x)))
- [")"])))
-
-(defmethod emit-constant clojure.lang.PersistentHashSet [x]
- (emit-meta-constant x
- (concat ["cljs.core.set(["]
- (comma-sep (map #(fn [] (emit-constant %)) x))
- ["])"])))
+(defn emit-constant-map [x]
+ (emit-meta-constant x
+ (concat ["cljs.core.hash_map("]
+ (comma-sep (map #(fn [] (emit-constant %))
+ (apply concat x)))
+ [")"])))
+
+(defn emit-constant-set [x]
+ (emit-meta-constant x
+ (concat ["cljs.core.set(["]
+ (comma-sep (map #(fn [] (emit-constant %)) x))
+ ["])"])))
+
+(defprotocol EmitConstant
+ (emit-constant [x]))
+
+(extend-protocol EmitConstant
+ nil (emit-constant [x] (emits "null"))
+ number (emit-constant [x] (emits x))
+ boolean (emit-constant [x] (emits (if x "true" "false")))
+ js/RegExp (emit-constant [x]
+ (let [[_ flags pattern] (re-find #"^(?:\(\?([idmsux]*)\))?(.*)" (str x))
+ all-slashes (js/RegExp. "\\/" "g")]
+ (emits (str \/ (.replace pattern all-slashes "\\\\/") \/ flags))))
+ string (emit-constant [x]
+ (cond
+ (symbol? x) (emit-constant-symbol x)
+ (keyword? x) (emit-constant-keyword x)
+ :else (emits (wrap-in-double-quotes (escape-string x)))))
+ cljs.core/EmptyList (emit-constant [x]
+ (emit-meta-constant x "cljs.core.List.EMPTY"))
+ cljs.core/List (emit-constant [x]
+ (emit-meta-constant x
+ (concat ["cljs.core.list("]
+ (comma-sep (map #(fn [] (emit-constant %)) x))
+ [")"])))
+ cljs.core/Cons (emit-constant [x]
+ (emit-meta-constant x
+ (concat ["cljs.core.list("]
+ (comma-sep (map #(fn [] (emit-constant %)) x))
+ [")"])))
+ cljs.core/PersistentVector (emit-constant [x]
+ (emit-meta-constant x
+ (concat ["cljs.core.vec(["]
+ (comma-sep (map #(fn [] (emit-constant %)) x))
+ ["])"])))
+ cljs.core/PersistentHashMap (emit-constant [x]
+ (emit-constant-map x))
+ cljs.core/PersistentArrayMap (emit-constant [x]
+ (emit-constant-map x))
+ cljs.core/PersistentTreeMap (emit-constant [x]
+ (emit-constant-map x))
+ cljs.core/PersistentHashSet (emit-constant [x]
+ (emit-constant-set x))
+ cljs.core/PersistentTreeSet (emit-constant [x]
+ (emit-constant-set x))
+)
(defn emit-block
[context statements ret]
@@ -212,11 +249,11 @@
(emits statements))
(emit ret))
-(defmacro emit-wrap [env & body]
- `(let [env# ~env]
- (when (= :return (:context env#)) (emits "return "))
- ~@body
- (when-not (= :expr (:context env#)) (emitln ";"))))
(defmethod emit :no-op [m])
@@ -554,7 +591,7 @@
(when (= :expr context) (emits "(function (){"))
(binding [*lexical-renames* (into *lexical-renames*
(when (= :statement context)
- (map #(vector (System/identityHashCode %)
+ (map #(vector (hash %)
(gensym (str (:name %) "-")))
bindings)))]
(doseq [{:keys [init] :as binding} bindings]
@@ -751,157 +788,171 @@
(emits (interleave (concat segs (repeat nil))
(concat args [nil]))))))
-(defn forms-seq
- "Seq of forms in a Clojure or ClojureScript file."
- ([f]
- (forms-seq f (clojure.lang.LineNumberingPushbackReader. (io/reader f))))
- ([f ^java.io.PushbackReader rdr]
- (if-let [form (binding [*ns* ana/*reader-ns*] (read rdr nil nil))]
- (lazy-seq (cons form (forms-seq f rdr)))
- (.close rdr))))
-
-(defn rename-to-js
- "Change the file extension from .cljs to .js. Takes a File or a
- String. Always returns a String."
- [file-str]
- (clojure.string/replace file-str #"\.cljs$" ".js"))
-
-(defn mkdirs
- "Create all parent directories for the passed file."
- [^java.io.File f]
- (.mkdirs (.getParentFile (.getCanonicalFile f))))
-
-(defmacro with-core-cljs
- "Ensure that core.cljs has been loaded."
- [& body]
- `(do (when-not (:defs (get @ana/namespaces 'cljs.core))
- (ana/analyze-file "cljs/core.cljs"))
- ~@body))
-
-(defn compile-file* [src dest]
- (with-core-cljs
- (with-open [out ^java.io.Writer (io/make-writer dest {})]
- (binding [*out* out
- ana/*cljs-ns* 'cljs.user
- ana/*cljs-file* (.getPath ^java.io.File src)
- *data-readers* tags/*cljs-data-readers*
- *position* (atom [0 0])
- *emitted-provides* (atom #{})]
- (loop [forms (forms-seq src)
- ns-name nil
- deps nil]
- (if (seq forms)
- (let [env (ana/empty-env)
- ast (ana/analyze env (first forms))]
- (do (emit ast)
- (if (= (:op ast) :ns)
- (recur (rest forms) (:name ast) (merge (:uses ast) (:requires ast)))
- (recur (rest forms) ns-name deps))))
- {:ns (or ns-name 'cljs.user)
- :provides [ns-name]
- :requires (if (= ns-name 'cljs.core) (set (vals deps)) (conj (set (vals deps)) 'cljs.core))
- :file dest}))))))
-
-(defn requires-compilation?
- "Return true if the src file requires compilation."
- [^java.io.File src ^java.io.File dest]
- (or (not (.exists dest))
- (> (.lastModified src) (.lastModified dest))))
-
-(defn compile-file
- "Compiles src to a file of the same name, but with a .js extension,
- in the src file's directory.
-
- With dest argument, write file to provided location. If the dest
- argument is a file outside the source tree, missing parent
- directories will be created. The src file will only be compiled if
- the dest file has an older modification time.
-
- Both src and dest may be either a String or a File.
-
- Returns a map containing {:ns .. :provides .. :requires .. :file ..}.
- If the file was not compiled returns only {:file ...}"
- ([src]
- (let [dest (rename-to-js src)]
- (compile-file src dest)))
- ([src dest]
- (let [src-file (io/file src)
- dest-file (io/file dest)]
- (if (.exists src-file)
- (if (requires-compilation? src-file dest-file)
- (do (mkdirs dest-file)
- (compile-file* src-file dest-file))
- {:file dest-file})
- (throw (java.io.FileNotFoundException. (str "The file " src " does not exist.")))))))
-
-(comment
- ;; flex compile-file
- (do
- (compile-file "/tmp/hello.cljs" "/tmp/something.js")
- (slurp "/tmp/hello.js")
-
- (compile-file "/tmp/somescript.cljs")
- (slurp "/tmp/somescript.js")))
-
-(defn path-seq
- [file-str]
- (->> java.io.File/separator
- java.util.regex.Pattern/quote
- re-pattern
- (string/split file-str)))
-
-(defn to-path
- ([parts]
- (to-path parts java.io.File/separator))
- ([parts sep]
- (apply str (interpose sep parts))))
-
-(defn to-target-file
- "Given the source root directory, the output target directory and
- file under the source root, produce the target file."
- [^java.io.File dir ^String target ^java.io.File file]
- (let [dir-path (path-seq (.getAbsolutePath dir))
- file-path (path-seq (.getAbsolutePath file))
- relative-path (drop (count dir-path) file-path)
- parents (butlast relative-path)
- parent-file (java.io.File. ^String (to-path (cons target parents)))]
- (java.io.File. parent-file ^String (rename-to-js (last relative-path)))))
-
-(defn cljs-files-in
- "Return a sequence of all .cljs files in the given directory."
- [dir]
- (filter #(let [name (.getName ^java.io.File %)]
- (and (.endsWith name ".cljs")
- (not= \. (first name))
- (not (contains? cljs-reserved-file-names name))))
- (file-seq dir)))
-
-(defn compile-root
- "Looks recursively in src-dir for .cljs files and compiles them to
- .js files. If target-dir is provided, output will go into this
- directory mirroring the source directory structure. Returns a list
- of maps containing information about each file which was compiled
- in dependency order."
- ([src-dir]
- (compile-root src-dir "out"))
- ([src-dir target-dir]
- (let [src-dir-file (io/file src-dir)]
- (loop [cljs-files (cljs-files-in src-dir-file)
- output-files []]
- (if (seq cljs-files)
- (let [cljs-file (first cljs-files)
- output-file ^java.io.File (to-target-file src-dir-file target-dir cljs-file)
- ns-info (compile-file cljs-file output-file)]
- (recur (rest cljs-files) (conj output-files (assoc ns-info :file-name (.getPath output-file)))))
- output-files)))))
-
-(comment
- ;; compile-root
- ;; If you have a standard project layout with all file in src
- (compile-root "src")
- ;; will produce a mirrored directory structure under "out" but all
- ;; files will be compiled to js.
- )
+
+(defn ns-snap []
+ (let [nss (read-string (pr-str (update-in @ana/namespaces
+ ['cljs.core :defs] dissoc '/)))]
+ (with-core-cljs
+ (binding [ana/*cljs-ns* 'cljs.user]
+ (spit "src/cljs/bs.js"
+ (apply str
+ (for [form ['(ns bs)
+ (list 'def 'nss (list 'quote nss))
+ '(defn reset [] (reset! cljs.analyzer/namespace nss))]]
+ (when form
+ (with-out-str
+ (emit (ana/analyze (ana/empty-env) form)))))))))))
(comment
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment