Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

merged

  • Loading branch information...
commit 5b7623873ff8713a556f3b52fe1912c98ac8bbc5 2 parents 293295b + 9326c01
@swannodette swannodette authored
View
20 script/bootstrap
@@ -5,14 +5,22 @@ set -e
mkdir -p lib
echo "Fetching Clojure..."
-curl -O -s http://repo1.maven.org/maven2/org/clojure/clojure/1.4.0/clojure-1.4.0.zip
-unzip -qu clojure-1.4.0.zip
-echo "Copying clojure-1.4.0/clojure-1.4.0.jar to lib/clojure.jar..."
-cp clojure-1.4.0/clojure-1.4.0.jar lib/clojure.jar
+curl -O -s http://repo1.maven.org/maven2/org/clojure/clojure/1.5.0-beta1/clojure-1.5.0-beta1.zip
+unzip -qu clojure-1.5.0-beta1.zip
+echo "Copying clojure-1.5.0-beta1/clojure-1.5.0-beta1.jar to lib/clojure.jar..."
+cp clojure-1.5.0-beta1/clojure-1.5.0-beta1.jar lib/clojure.jar
+
echo "Cleaning up Clojure directory..."
-rm -rf clojure-1.4.0/
+rm -rf clojure-1.5.0-beta1/
echo "Cleaning up Clojure archive..."
-rm clojure-1.4.0.zip
+rm clojure-1.5.0-beta1.zip
+
+echo "Fetching data.json..."
+curl -O -s http://repo1.maven.org/maven2/org/clojure/data.json/0.2.0/data.json-0.2.0.jar
+echo "Copying data.json-0.2.0.jar to lib/data.json-0.2.0.jar..."
+cp data.json-0.2.0.jar lib/data.json-0.2.0.jar
+echo "Cleaning up data.json..."
+rm data.json-0.2.0.jar
echo "Fetching Google Closure library..."
mkdir -p closure/library
View
64 src/clj/cljs/analyzer.clj
@@ -65,6 +65,12 @@
*cljs-warn-fn-deprecated* false]
~@body))
+(defn get-line [x env]
+ (or (-> x meta :line) (:line env)))
+
+(defn get-col [x env]

Nit-picky: col or column. Pick one!

@swannodette Collaborator

Good point.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
+ (or (-> x meta :column) (:column env)))
+
(defn load-core []
(when (not @-cljs-macros-loaded)
(reset! -cljs-macros-loaded true)
@@ -96,10 +102,16 @@
[& args]
`(.println System/err (str ~@args)))
-(defn source-info [env]
- (when-let [line (:line env)]
- {:file *cljs-file*
- :line line}))
+(defn source-info
+ ([env]
+ (when-let [line (:line env)]
+ {:file *cljs-file*
+ :line (get-line name env)
+ :column (get-col name env)}))
+ ([name env]
+ {:file *cljs-file*
+ :line (get-line name env)
+ :column (get-col name env)}))
(defn message [env s]
(str s (when (:line env)
@@ -264,7 +276,10 @@
name (first cblock)
locals (:locals catchenv)
locals (if name
- (assoc locals name {:name name})
+ (assoc locals name
+ {:name name
+ :line (get-line name env)
+ :column (get-col name env)})
locals)
catch (when cblock
(analyze (assoc catchenv :locals locals) `(do ~@(rest cblock))))
@@ -304,9 +319,14 @@
(update-in env [:ns :excludes] conj sym))
env)
name (:name (resolve-var (dissoc env :locals) sym))
+ var-expr (assoc (analyze (-> env (dissoc :locals)
+ (assoc :context :expr)
+ (assoc :def-var true))
+ sym)
+ :op :var)
init-expr (when (contains? args :init)
(disallowing-recur
- (analyze (assoc env :context :expr) (:init args) sym)))
+ (analyze (assoc env :context :expr) (:init args) sym)))
fn-var? (and init-expr (= (:op init-expr) :fn))
export-as (when-let [export-val (-> sym meta :export)]
(if (= true export-val) name export-val))
@@ -324,7 +344,7 @@
sym-meta
(when doc {:doc doc})
(when dynamic {:dynamic true})
- (source-info env)
+ (source-info name env)
;; the protocol a protocol fn belongs to
(when protocol
{:protocol protocol})
@@ -341,7 +361,7 @@
:max-fixed-arity (:max-fixed-arity init-expr)
:method-params (map :params (:methods init-expr))})))
(merge {:env env :op :def :form form
- :name name :doc doc :init init-expr}
+ :name name :var var-expr :doc doc :init init-expr}
(when tag {:tag tag})
(when dynamic {:dynamic true})
(when export-as {:export export-as})
@@ -354,8 +374,10 @@
body (next form)
[locals params] (reduce (fn [[locals params] name]
(let [param {:name name
+ :line (get-line name env)
+ :column (get-col name env)
:tag (-> name meta :tag)
- :shadow (locals name)}]
+ :shadow (when locals (locals name))}]
[(assoc locals name param) (conj params param)]))
[locals []] param-names)
fixed-arity (count (if variadic (butlast params) params))
@@ -373,7 +395,7 @@
;;turn (fn [] ...) into (fn ([]...))
meths (if (vector? (first meths)) (list meths) meths)
locals (:locals env)
- locals (if name (assoc locals name {:name name :shadow (locals name)}) locals)
+ locals (if (and locals name) (assoc locals name {:name name :shadow (locals name)}) locals)
type (-> form meta ::type)
fields (-> form meta ::fields)
protocol-impl (-> form meta :protocol-impl)
@@ -381,6 +403,8 @@
locals (reduce (fn [m fld]
(assoc m fld
{:name fld
+ :line (get-line fld env)
+ :column (get-col fld env)
:field true
:mutable (-> fld meta :mutable)
:unsynchronized-mutable (-> fld meta :unsynchronized-mutable)
@@ -426,6 +450,8 @@
[meth-env bes]
(reduce (fn [[{:keys [locals] :as env} bes] n]
(let [be {:name n
+ :line (get-line n env)
+ :column (get-col n env)
:tag (-> n meta :tag)
:local true
:shadow (locals n)}]
@@ -467,6 +493,8 @@
(let [init-expr (binding [*loop-lets* (cons {:params bes} (or *loop-lets* ()))]
(analyze env init))
be {:name name
+ :line (get-line name env)
+ :column (get-col name env)
:init init-expr
:tag (or (-> name meta :tag)
(-> init-expr :tag)
@@ -700,7 +728,7 @@
:num-fields (count fields))]
(merge m
{:protocols (-> tsym meta :protocols)}
- (source-info env)))))
+ (source-info tsym env)))))
{:env env :op :deftype* :form form :t t :fields fields :pmasks pmasks}))
(defmethod parse 'defrecord*
@@ -711,7 +739,7 @@
(let [m (assoc (or m {}) :name t :type true)]
(merge m
{:protocols (-> tsym meta :protocols)}
- (source-info env)))))
+ (source-info tsym env)))))
{:env env :op :defrecord* :form form :t t :fields fields :pmasks pmasks}))
;; dot accessor code
@@ -843,7 +871,9 @@
lb (-> env :locals sym)]
(if lb
(assoc ret :op :var :info lb)
- (assoc ret :op :var :info (resolve-existing-var env sym)))))
+ (if-not (:def-var env)
+ (assoc ret :op :var :info (resolve-existing-var env sym))
+ (assoc ret :op :var :info (resolve-var env sym))))))
(defn get-expander [sym env]
(let [mvar
@@ -886,9 +916,11 @@
(defn analyze-seq
[env form name]
- (let [env (assoc env :line
- (or (-> form meta :line)
- (:line env)))]
+ (let [env (assoc env
+ :line (or (-> form meta :line)
+ (:line env))
+ :column (or (-> form meta :column)
+ (:column env)))]
(let [op (first form)]
(assert (not (nil? op)) "Can't call nil")
(let [mform (macroexpand-1 env form)]
View
77 src/clj/cljs/closure.clj
@@ -35,8 +35,10 @@
"
(:require [cljs.compiler :as comp]
[cljs.analyzer :as ana]
+ [cljs.source-map :as sm]
[clojure.java.io :as io]
- [clojure.string :as string])
+ [clojure.string :as string]
+ [clojure.data.json :as json])
(:import java.io.File
java.io.BufferedInputStream
java.net.URL
@@ -53,6 +55,10 @@
com.google.javascript.jscomp.JSError
com.google.javascript.jscomp.CommandLineRunner))
+(defmacro ^:private debug-prn
+ [& args]
+ `(.println System/err (str ~@args)))
+
(def name-chars (map char (concat (range 48 57) (range 65 90) (range 97 122))))
(defn random-char []
@@ -230,6 +236,10 @@
(-requires [this] "A list of namespaces that this JavaScript requires.")
(-source [this] "The JavaScript source string."))
+(defprotocol ISourceMap
+ (-source-url [this] "Return the CLJS source url")
+ (-source-map [this] "Return the CLJS compiler generated JS source mapping"))
+
(extend-protocol IJavaScript
String
@@ -249,22 +259,32 @@
s
(slurp (io/reader (-url this))))))
-(defrecord JavaScriptFile [foreign ^URL url provides requires]
+(defrecord JavaScriptFile [foreign ^URL url ^URL source-url provides requires lines source-map]
IJavaScript
(-foreign? [this] foreign)
(-url [this] url)
(-provides [this] provides)
(-requires [this] requires)
- (-source [this] (slurp (io/reader url))))
+ (-source [this] (slurp (io/reader url)))
+ ISourceMap
+ (-source-url [this] source-url)
+ (-source-map [this] source-map))
-(defn javascript-file [foreign ^URL url provides requires]
- (JavaScriptFile. foreign url (map name provides) (map name requires)))
+(defn javascript-file
+ ([foreign ^URL url provides requires]
+ (javascript-file foreign url nil provides requires nil nil))
+ ([foreign ^URL url source-url provides requires lines source-map]
+ (JavaScriptFile. foreign url source-url (map name provides) (map name requires) lines source-map)))
(defn map->javascript-file [m]
- (javascript-file (:foreign m)
- (to-url (:file m))
- (:provides m)
- (:requires m)))
+ (javascript-file
+ (:foreign m)
+ (to-url (:file m))
+ (to-url (:source-file m))
+ (:provides m)
+ (:requires m)
+ (:lines m)
+ (:source-map m)))
(defn read-js
"Read a JavaScript file returning a map of file information."
@@ -336,6 +356,7 @@
(defn output-directory [opts]
(or (:output-dir opts) "out"))
+;; cache from js file path to map of {:file .. :provides .. :requires ..}
(def compiled-cljs (atom {}))
(defn compiled-file
@@ -362,7 +383,7 @@
[^File file {:keys [output-file] :as opts}]
(if output-file
(let [out-file (io/file (output-directory opts) output-file)]
- (compiled-file (comp/compile-file file out-file)))
+ (compiled-file (comp/compile-file file out-file opts)))
(compile-form-seq (comp/forms-seq file))))
(defn compile-dir
@@ -371,7 +392,7 @@
[^File src-dir opts]
(let [out-dir (output-directory opts)]
(map compiled-file
- (comp/compile-root src-dir out-dir))))
+ (comp/compile-root src-dir out-dir opts))))
(defn path-from-jarfile
"Given the URL of a file within a jar, return the path of the file
@@ -688,7 +709,33 @@
(when-let [name (:source-map opts)]
(let [out (io/writer name)]
(.appendTo (.getSourceMap closure-compiler) out name)
- (.close out)))
+ (.close out))
+ (let [sm-json (-> (io/file name) slurp
+ (json/read-str :key-fn keyword))
+ closure-source-map (sm/decode sm-json)]
+ (loop [sources (seq sources)
+ merged (sorted-map-by
+ (sm/source-compare
+ (map (fn [source]
+ (if-let [^URL source-url (:source-url source)]
+ (.getPath source-url)
+ (let [^URL url (:url source)]
+ (.getPath url))))
+ sources)))]
+ (if sources
+ (let [source (first sources)]
+ (recur (next sources)
+ (let [path (.getPath ^URL (:url source))]
+ (if-let [compiled (get @compiled-cljs path)]
+ (assoc merged (.getPath ^URL (:source-url source))
+ (sm/merge-source-maps
+ (:source-map compiled)
+ (get closure-source-map path)))
+ (assoc merged path (get closure-source-map path))))))
+ (let [out-name (str name ".merged")]
+ (spit (io/file out-name)
+ (sm/encode merged
+ {:lines (+ (:lineCount sm-json) 2) :file (:file sm-json)})))))))
source)
(report-failure result))))
@@ -879,6 +926,11 @@
(str ";(function(){\n" js "\n})();\n")
js))
+(defn add-source-map-link [{:keys [source-map] :as opts} js]
+ (if source-map
+ (str js "\n//@ sourceMappingURL=" source-map ".merged")
+ js))
+
(defn build
"Given a source which can be compiled, produce runnable JavaScript."
[source opts]
@@ -911,6 +963,7 @@
(apply optimize all-opts)
(add-header all-opts)
(add-wrapper all-opts)
+ (add-source-map-link all-opts)
(output-one-file all-opts))
(apply output-unoptimized all-opts js-sources))))))
View
156 src/clj/cljs/compiler.clj
@@ -33,11 +33,18 @@
"volatile" "while" "with" "yield" "methods"
"null"})
-(def ^:dynamic *position* nil)
+(def ^:dynamic *cljs-source-map* nil)
+(def ^:dynamic *cljs-gen-col* nil)
+(def ^:dynamic *cljs-gen-line* nil)
+
(def ^:dynamic *emitted-provides* nil)
(def ^:dynamic *lexical-renames* {})
(def cljs-reserved-file-names #{"deps.cljs"})
+(defmacro ^:private debug-prn
+ [& args]
+ `(.println System/err (str ~@args)))
+
(defonce ns-first-segments (atom '#{"cljs" "clojure"}))
(defn munge
@@ -101,16 +108,14 @@
(defn emits [& xs]
(doseq [x xs]
(cond
- (nil? x) nil
- (map? x) (emit x)
- (seq? x) (apply emits x)
- (fn? x) (x)
- :else (do
- (let [s (print-str x)]
- (when *position*
- (swap! *position* (fn [[line column]]
- [line (+ column (count s))])))
- (print s)))))
+ (nil? x) nil
+ (map? x) (emit x)
+ (seq? x) (apply emits x)
+ (fn? x) (x)
+ :else (let [s (print-str x)]
+ (when *cljs-gen-col*
+ (swap! *cljs-gen-col* (fn [col] (+ col (count s)))))
+ (print s))))
nil)
(defn ^String emit-str [expr]
@@ -118,14 +123,11 @@
(defn emitln [& xs]
(apply emits xs)
- ;; Prints column-aligned line number comments; good test of *position*.
- ;(when *position*
- ; (let [[line column] @*position*]
- ; (print (apply str (concat (repeat (- 120 column) \space) ["// " (inc line)])))))
(println)
- (when *position*
- (swap! *position* (fn [[line column]]
- [(inc line) 0])))
+ (when *cljs-gen-line*
+ (swap! *cljs-gen-line* inc))
+ (when *cljs-gen-col*
+ (reset! *cljs-gen-col* 0))
nil)
(defn ^String emit-str [expr]
@@ -219,12 +221,25 @@
(defmethod emit :var
[{:keys [info env] :as arg}]
- (let [n (:name info)
- n (if (= (namespace n) "js")
- (name n)
- info)]
+ (let [var-name (:name info)
+ info (if (= (namespace var-name) "js")
+ (name var-name)
+ info)]
+ (when *cljs-source-map*
+ (when (and (:line env) (symbol? var-name))
+ (let [{:keys [line column]} env]
+ (swap! *cljs-source-map*
+ (fn [m]
+ (let [minfo {:gcol @*cljs-gen-col*
+ :gline @*cljs-gen-line*
+ :name var-name}]
+ (update-in m [line]
+ (fnil (fn [m]
+ (update-in m [(or column 0)]
+ (fnil (fn [v] (conj v minfo)) [])))
+ (sorted-map)))))))))
(when-not (= :statement (:context env))
- (emit-wrap env (emits (munge n))))))
+ (emit-wrap env (emits (munge info))))))
(defmethod emit :meta
[{:keys [expr meta env]}]
@@ -347,10 +362,10 @@
(emitln "*/")))))
(defmethod emit :def
- [{:keys [name init env doc export]}]
+ [{:keys [name var init env doc export]}]
(let [mname (munge name)]
(emit-comment doc (:jsdoc init))
- (emits mname)
+ (emits var)
(when init
(emits " = " init)
;; NOTE: JavaScriptCore does not like this under advanced compilation
@@ -774,29 +789,38 @@
(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 compile-file*
+ ([src dest] (compile-file* src dest nil))
+ ([src dest opts]
+ (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*
+ *emitted-provides* (atom #{})
+ *cljs-source-map* (when (:source-map opts) (atom (sorted-map)))
+ *cljs-gen-line* (atom 0)
+ *cljs-gen-col* (atom 0)]
+ (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))))
+ (merge
+ {: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
+ :source-file src
+ :lines @*cljs-gen-line*}
+ (when (:source-map opts)
+ {:source-map @*cljs-source-map*})))))))))
(defn requires-compilation?
"Return true if the src file requires compilation."
@@ -804,7 +828,7 @@
(or (not (.exists dest))
(> (.lastModified src) (.lastModified dest))))
-(defn parse-ns [src dest]
+(defn parse-ns [src dest opts]
(with-core-cljs
(binding [ana/*cljs-ns* 'cljs.user]
(loop [forms (forms-seq src)]
@@ -819,7 +843,9 @@
:requires (if (= ns-name 'cljs.core)
(set (vals deps))
(conj (set (vals deps)) 'cljs.core))
- :file dest})
+ :file dest
+ :source-file src
+ :lines (-> dest io/reader line-seq count)})
(recur (rest forms)))))))))
(defn compile-file
@@ -836,20 +862,22 @@
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)))
+ (let [dest (rename-to-js src)]
+ (compile-file src dest nil)))
([src dest]
- (let [src-file (io/file src)
+ (compile-file src dest nil))
+ ([src dest opts]
+ (let [src-file (io/file src)
dest-file (io/file dest)]
- (if (.exists src-file)
- (try
- (if (requires-compilation? src-file dest-file)
- (do (mkdirs dest-file)
- (compile-file* src-file dest-file))
- (parse-ns src-file dest-file))
- (catch Exception e
- (throw (ex-info (str "failed compiling file:" src) {:file src} e))))
- (throw (java.io.FileNotFoundException. (str "The file " src " does not exist.")))))))
+ (if (.exists src-file)
+ (try
+ (if (or (requires-compilation? src-file dest-file) (:source-map opts))
+ (do (mkdirs dest-file)
+ (compile-file* src-file dest-file opts))
+ (parse-ns src-file dest-file opts))
+ (catch Exception e
+ (throw (ex-info (str "failed compiling file:" src) {:file src} e))))
+ (throw (java.io.FileNotFoundException. (str "The file " src " does not exist.")))))))
(comment
;; flex compile-file
@@ -902,13 +930,15 @@
([src-dir]
(compile-root src-dir "out"))
([src-dir target-dir]
+ (compile-root src-dir target-dir nil))
+ ([src-dir target-dir opts]
(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)]
+ ns-info (compile-file cljs-file output-file opts)]
(recur (rest cljs-files) (conj output-files (assoc ns-info :file-name (.getPath output-file)))))
output-files)))))
View
195 src/clj/cljs/source_map.clj
@@ -0,0 +1,195 @@
+(ns cljs.source-map
+ (:require [clojure.java.io :as io]
+ [clojure.string :as string]
+ [clojure.data.json :as json]
+ [clojure.set :as set]
+ [clojure.pprint :as pp]
+ [cljs.source-map.base64-vlq :as base64-vlq]))
+
+;; -----------------------------------------------------------------------------
+;; Utilities
+
+(defn indexed-sources [sources]
+ (->> sources
+ (map-indexed (fn [a b] [a b]))
+ (reduce (fn [m [i v]] (assoc m v i)) {})))
+
+(defn source-compare [sources]
+ (let [sources (indexed-sources sources)]
+ (fn [a b] (compare (sources a) (sources b)))))
+
+;; -----------------------------------------------------------------------------
+;; Decoding
+
+(defn seg->map [seg source-map]
+ (let [[gcol source line col name] seg]
+ {:gcol gcol
+ :source (nth (:sources source-map) source)
+ :line line
+ :col col
+ :name (when-let [name (-> seg meta :name)]
+ (nth (:names source-map) name))}))
+
+(defn seg-combine [seg relseg]
+ (let [[gcol source line col name] seg
+ [rgcol rsource rline rcol rname] relseg
+ nseg [(+ gcol rgcol)
+ (+ (or source 0) rsource)
+ (+ (or line 0) rline)
+ (+ (or col 0) rcol)
+ (+ (or name 0) rname)]]
+ (if name
+ (with-meta nseg {:name (+ name rname)})
+ nseg)))
+
+(defn update-result [result segmap gline]
+ (let [{:keys [gcol source line col name]} segmap
+ d {:gline gline
+ :gcol gcol}
+ d (if name (assoc d :name name) d)]
+ (update-in result [source]
+ (fnil (fn [m]
+ (update-in m [line]
+ (fnil (fn [m]
+ (update-in m [col]
+ (fnil (fn [v] (conj v d))
+ [])))
+ (sorted-map))))
+ (sorted-map)))))
+
+(defn decode
+ ([source-map]
+ (decode (:mappings source-map) source-map))
+ ([mappings source-map]
+ (let [{:keys [sources]} source-map
+ relseg-init [0 0 0 0 0]
+ lines (seq (string/split mappings #";"))]
+ (loop [gline 0
+ lines lines
+ relseg relseg-init
+ result (sorted-map-by (source-compare sources))]
+ (if lines
+ (let [line (first lines)
+ [result relseg]
+ (if (string/blank? line)
+ [result relseg]
+ (let [segs (seq (string/split line #","))]
+ (loop [segs segs relseg relseg result result]
+ (if segs
+ (let [seg (first segs)
+ nrelseg (seg-combine (base64-vlq/decode seg) relseg)]
+ (recur (next segs) nrelseg
+ (update-result result (seg->map nrelseg source-map) gline)))
+ [result relseg]))))]
+ (recur (inc gline) (next lines) (assoc relseg 0 0) result))
+ result)))))
+
+;; -----------------------------------------------------------------------------
+;; Encoding
+
+(defn lines->segs [lines]
+ (let [relseg (atom [0 0 0 0 0])]
+ (reduce
+ (fn [segs cols]
+ (swap! relseg
+ (fn [[_ source line col name]]
+ [0 source line col name]))
+ (conj segs
+ (reduce
+ (fn [cols [gcol sidx line col name :as seg]]
+ (let [offset (map - seg @relseg)]
+ (swap! relseg
+ (fn [[_ _ _ _ lname]]
+ [gcol sidx line col (or name lname)]))
+ (conj cols (base64-vlq/encode offset))))
+ [] cols)))
+ [] lines)))
+
+(defn encode [m opts]
+ (let [lines (atom [[]])
+ names->idx (atom {})
+ name-idx (atom 0)
+ info->segv
+ (fn [info source-idx line col]
+ (let [segv [(:gcol info) source-idx line col]]
+ (if-let [name (:name info)]
+ (let [idx (if-let [idx (get @names->idx name)]
+ idx
+ (let [cidx @name-idx]
+ (swap! names->idx assoc name cidx)
+ (swap! name-idx inc)
+ cidx))]
+ (conj segv idx))
+ segv)))
+ encode-cols
+ (fn [infos source-idx line col]
+ (doseq [info infos]
+ (let [segv (info->segv info source-idx line col)
+ gline (:gline info)
+ lc (count @lines)]
+ (if (> gline (dec lc))
+ (swap! lines
+ (fn [lines]
+ (conj (into lines (repeat (dec (- gline (dec lc))) [])) [segv])))
+ (swap! lines
+ (fn [lines]
+ (update-in lines [gline] conj segv)))))))]
+ (doseq [[source-idx [_ lines]] (map-indexed (fn [i v] [i v]) m)]
+ (doseq [[line cols] lines]
+ (doseq [[col infos] cols]
+ (encode-cols infos source-idx line col))))
+ (with-out-str
+ (json/pprint
+ {"version" 3
+ "file" (:file opts)
+ "sources" (into [] (keys m))
+ "lineCount" (:lines opts)
+ "mappings" (->> (lines->segs @lines)
+ (map #(string/join "," %))
+ (string/join ";"))
+ "names" (into [] (map (set/map-invert @names->idx)
+ (range (count @names->idx))))}
+ :escape-slash false))))
+
+;; -----------------------------------------------------------------------------
+;; Merging
+
+(defn merge-source-maps
+ [cljs-map closure-map]
+ (loop [line-map-seq (seq cljs-map) new-lines (sorted-map)]
+ (if line-map-seq
+ (let [[line col-map] (first line-map-seq)
+ new-cols
+ (loop [col-map-seq (seq col-map) new-cols (sorted-map)]
+ (if col-map-seq
+ (let [[col infos] (first col-map-seq)]
+ (recur (next col-map-seq)
+ (assoc new-cols col
+ (reduce (fn [v {:keys [gline gcol]}]
+ (into v (get-in closure-map [gline gcol])))
+ [] infos))))
+ new-cols))]
+ (recur (next line-map-seq)
+ (assoc new-lines line new-cols)))
+ new-lines)))
+
+(comment
+ ;; INSTRUCTIONS:
+
+ ;; switch into samples/hello
+ ;; run repl to start clojure
+ ;; build with
+
+ (require '[cljs.closure :as cljsc])
+ (cljsc/build "src" {:optimizations :simple :output-to "hello.js" :source-map "hello.js.map"})
+
+ ;; load source map
+ (def raw-source-map
+ (json/read-str (slurp (io/file "hello.js.map")) :key-fn keyword))
+
+ ;; test it out
+ (first (decode raw-source-map))
+
+ ;; decoded source map preserves file order
+ (= (keys (decode raw-source-map)) (:sources raw-source-map))
+ )
View
17 src/clj/cljs/source_map/base64.clj
@@ -0,0 +1,17 @@
+(ns cljs.source-map.base64)
+
+(def chars64 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/")
+(def char->int (zipmap chars64 (range 0 64)))
+(def int->char (zipmap (range 0 64) chars64))
+
+(defn encode [n]
+ (let [e (find int->char n)]
+ (if e
+ (second e)
+ (throw (Error. (str "Must be between 0 and 63: " n))))))
+
+(defn ^Character decode [c]
+ (let [e (find char->int c)]
+ (if e
+ (second e)
+ (throw (Error. (str "Not a valid base 64 digit: " c))))))
View
96 src/clj/cljs/source_map/base64_vlq.clj
@@ -0,0 +1,96 @@
+(ns cljs.source-map.base64-vlq
+ (require [clojure.string :as string]
+ [cljs.source-map.base64 :as base64]))
+
+(def ^:const vlq-base-shift 5)
+(def ^:const vlq-base (bit-shift-left 1 vlq-base-shift))
+(def ^:const vlq-base-mask (dec vlq-base))
+(def ^:const vlq-continuation-bit vlq-base)
+
+(defn bit-shift-right-zero-fill [x n]
+ (bit-shift-right (bit-and 0xFFFFFFFF x) n))
+
+(defn to-vlq-signed [v]
+ (if (neg? v)
+ (inc (bit-shift-left (- v) 1))
+ (+ (bit-shift-left v 1) 0)))
+
+(defn from-vlq-signed [v]
+ (let [neg? (= (bit-and v 1) 1)
+ shifted (bit-shift-right v 1)]
+ (if neg?
+ (- shifted)
+ shifted)))
+
+(defn encode-val [n]
+ (let [sb (StringBuilder.)
+ vlq (to-vlq-signed n)]
+ (loop [digit (bit-and vlq vlq-base-mask)
+ vlq (bit-shift-right-zero-fill vlq vlq-base-shift)]
+ (if (pos? vlq)
+ (let [digit (bit-or digit vlq-continuation-bit)]
+ (.append sb (base64/encode digit))
+ (recur (bit-and vlq vlq-base-mask)
+ (bit-shift-right-zero-fill vlq vlq-base-shift)))
+ (.append sb (base64/encode digit))))
+ (str sb)))
+
+(defn encode [v]
+ (apply str (map encode-val v)))
+
+(defn decode [^String s]
+ (let [l (.length s)]
+ (loop [i 0 result 0 shift 0]
+ (when (>= i l)
+ (throw (Error. "Expected more digits in base 64 VLQ value.")))
+ (let [digit (base64/decode (.charAt s i))]
+ (let [i (inc i)
+ continuation? (pos? (bit-and digit vlq-continuation-bit))
+ digit (bit-and digit vlq-base-mask)
+ result (+ result (bit-shift-left digit shift))
+ shift (+ shift vlq-base-shift)]
+ (if continuation?
+ (recur i result shift)
+ (lazy-seq
+ (cons (from-vlq-signed result)
+ (let [s (.substring s i)]
+ (when-not (string/blank? s)
+ (decode s)))))))))))
+
+(comment
+ ;; tests
+
+ (bit-shift-right-zero-fill 127 1) ;; 63
+ (bit-shift-right-zero-fill -127 1) ;; 2147483584
+
+ (to-vlq-signed 32) ;; 64
+ (to-vlq-signed -32) ;; 65
+ (from-vlq-signed 64) ;; 32
+ (from-vlq-signed 65) ;; -32
+
+ ;; Base64 VLQ can only represent 32bit values
+
+ (encode-val 32) ; "gC"
+ (decode "gC") ; {:value 32 :rest ""}
+
+ (decode "AAgBC") ; (0 0 16 1)
+
+ ;; lines kept count by semicolons, segments delimited by commas
+ ;; the above is gline 0, gcol 0, file 0, line 16, col 1, no name if this was the first segment read
+
+ (decode "AAggBC") ; very clever way to encode large values
+ (decode "AAggBCA") ; 5 values instead of 4
+
+ (encode [0 0 16 1]) ; "AAgBC"
+
+ (decode "IAWdD") ; (4 0 11 -14 -1) this is correct
+ ;; gline N, gcol +4, file +0, line +11, col -14, name -1
+
+ ;; Notes about format
+ ;; we always have 1, 4, or 5 values, all zero-based indexes
+ ;; 1. generated col - relative - reset on every new line in generated source
+ ;; 2. index into sources list - relative
+ ;; 3. original line - relative
+ ;; 4. origin column - relative
+ ;; 5. name - relative
+ )
Please sign in to comment.
Something went wrong with that request. Please try again.