From 297f5952225ebfd5c26d56d14cf9bbef0c9d688e Mon Sep 17 00:00:00 2001 From: Brandon Bloom Date: Sat, 2 Jun 2012 15:13:36 -0700 Subject: [PATCH] Move all symbol munging from parse&analyze to emit --- src/clj/cljs/compiler.clj | 191 ++++++++++++++++++++------------------------- src/cljs/cljs/core.cljs | 2 +- 2 files changed, 86 insertions(+), 107 deletions(-) diff --git a/src/clj/cljs/compiler.clj b/src/clj/cljs/compiler.clj index 2a05f2b..a7b90ae 100644 --- a/src/clj/cljs/compiler.clj +++ b/src/clj/cljs/compiler.clj @@ -67,17 +67,16 @@ (str s (when (:line env) (str " at line " (:line env) " " *cljs-file*)))))) -(defn munge [s] - (let [ss (str s) - ms (if (.contains ss "]") - (let [idx (inc (.lastIndexOf ss "]"))] - (str (subs ss 0 idx) - (clojure.lang.Compiler/munge (subs ss idx)))) - (clojure.lang.Compiler/munge ss)) - ms (if (js-reserved ms) (str ms "$") ms)] - (if (symbol? s) - (symbol ms) - ms))) +(defn munge + ([s] (munge s js-reserved)) + ([s reserved] + (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)] + (if (symbol? s) + (symbol ms) + ms)))) (defn confirm-var-exists [env prefix suffix] (when *cljs-warn-on-undeclared* @@ -97,15 +96,9 @@ (and (get (:defs (@namespaces 'cljs.core)) sym) (not (contains? (-> env :ns :excludes) sym)))) -(defn js-var [sym] - (let [parts (string/split (name sym) #"\.") - first (first parts) - step (fn [part] (str "['" part "']"))] - (apply str first (map step (rest parts))))) - (defn resolve-existing-var [env sym] (if (= (namespace sym) "js") - {:name (js-var sym) :ns 'js} + {:name (name sym) :ns 'js} (let [s (str sym) lb (-> env :locals sym)] (cond @@ -117,31 +110,27 @@ full-ns (resolve-ns-alias env ns)] (confirm-var-exists env full-ns (symbol (name sym))) (merge (get-in @namespaces [full-ns :defs (symbol (name sym))]) - {:name (symbol (str full-ns "." (munge (name sym)))) - :name-sym (symbol (str full-ns) (str (name sym))) + {:name (symbol (str full-ns) (str (name sym))) :ns full-ns})) (.contains s ".") (let [idx (.indexOf s ".") prefix (symbol (subs s 0 idx)) - suffix (subs s idx) + suffix (subs s (inc idx)) lb (-> env :locals prefix)] (if lb - {:name (munge (symbol (str (:name lb) suffix))) - :name-sym (symbol (str (:name lb) suffix))} + {:name (symbol (str (:name lb) suffix))} (do (confirm-var-exists env prefix (symbol suffix)) (merge (get-in @namespaces [prefix :defs (symbol suffix)]) - {:name (munge sym) - :name-sym (symbol (str prefix) suffix) + {:name (if (= "" prefix) (symbol suffix) (symbol (str prefix) suffix)) :ns prefix})))) (get-in @namespaces [(-> env :ns :name) :uses sym]) (let [full-ns (get-in @namespaces [(-> env :ns :name) :uses sym])] (merge (get-in @namespaces [full-ns :defs sym]) - {:name (symbol (str full-ns "." (munge (name sym)))) - :name-sym (symbol (str full-ns) (str sym)) + {:name (symbol (str full-ns) (str sym)) :ns (-> env :ns :name)})) :else @@ -150,13 +139,12 @@ (-> env :ns :name))] (confirm-var-exists env full-ns sym) (merge (get-in @namespaces [full-ns :defs sym]) - {:name (munge (symbol (str full-ns "." (munge (name sym))))) - :name-sym (symbol (str full-ns) (str sym)) + {:name (symbol (str full-ns) (str sym)) :ns full-ns})))))) (defn resolve-var [env sym] (if (= (namespace sym) "js") - {:name (js-var sym)} + {:name (name sym)} (let [s (str sym) lb (-> env :locals sym)] (cond @@ -165,7 +153,7 @@ (namespace sym) (let [ns (namespace sym) ns (if (= "clojure.core" ns) "cljs.core" ns)] - {:name (symbol (str (resolve-ns-alias env ns) "." (munge (name sym))))}) + {:name (symbol (str (resolve-ns-alias env ns) "." (name sym)))}) (.contains s ".") (let [idx (.indexOf s ".") @@ -173,21 +161,21 @@ suffix (subs s idx) lb (-> env :locals prefix)] (if lb - {:name (munge (symbol (str (:name lb) suffix)))} - {:name (munge sym)})) + {:name (symbol (str (:name lb) suffix))} + {:name sym})) (get-in @namespaces [(-> env :ns :name) :uses sym]) (let [full-ns (get-in @namespaces [(-> env :ns :name) :uses sym])] (merge (get-in @namespaces [full-ns :defs sym]) - {:name (symbol (str full-ns "." (munge (name sym))))})) + {:name (symbol (str full-ns "." (name sym)))})) :else (let [s (str (if (core-name? env sym) 'cljs.core (-> env :ns :name)) - "." (munge (name sym)))] - {:name (munge (symbol s))}))))) + "." (name sym))] + {:name (symbol s)}))))) (defn confirm-bindings [env names] (doseq [name names] @@ -196,7 +184,7 @@ (when (and *cljs-warn-on-dynamic* ev (not (-> ev :dynamic))) (warning env - (str "WARNING: " (:name-sym ev) " not declared ^:dynamic")))))) + (str "WARNING: " (:name ev) " not declared ^:dynamic")))))) (defn- comma-sep [xs] (interpose "," xs)) @@ -468,7 +456,7 @@ (if init (do (emit-comment doc (:jsdoc init)) - (emits name) + (emits (munge name)) (emits " = " init) (when-not (= :expr (:context env)) (emitln ";")) (when export @@ -478,7 +466,8 @@ (defn emit-apply-to [{:keys [name params env]}] (let [arglist (gensym "arglist__") - delegate-name (str name "__delegate")] + delegate-name (str (munge name) "__delegate") + params (map munge params)] (emitln "(function (" arglist "){") (doseq [[i param] (map-indexed vector (butlast params))] (emits "var " param " = cljs.core.first(") @@ -504,7 +493,7 @@ (defn emit-fn-method [{:keys [gthis name variadic params statements ret env recurs max-fixed-arity]}] (emit-wrap env - (emitln "(function " name "(" (comma-sep params) "){") + (emitln "(function " (munge name) "(" (comma-sep (map munge params)) "){") (when gthis (emitln "var " gthis " = this;")) (when recurs (emitln "while(true){")) @@ -518,7 +507,9 @@ [{:keys [gthis name variadic params statements ret env recurs max-fixed-arity] :as f}] (emit-wrap env (let [name (or name (gensym)) - delegate-name (str name "__delegate")] + mname (munge name) + params (map munge params) + delegate-name (str mname "__delegate")] (emitln "(function() { ") (emitln "var " delegate-name " = function (" (comma-sep params) "){") (when recurs (emitln "while(true){")) @@ -528,10 +519,10 @@ (emitln "}")) (emitln "};") - (emitln "var " name " = function (" (comma-sep - (if variadic - (concat (butlast params) ['var_args]) - params)) "){") + (emitln "var " mname " = function (" (comma-sep + (if variadic + (concat (butlast params) ['var_args]) + params)) "){") (when gthis (emitln "var " gthis " = this;")) (when variadic @@ -542,21 +533,22 @@ (emitln "return " delegate-name ".call(" (string/join ", " (cons "this" params)) ");") (emitln "};") - (emitln name ".cljs$lang$maxFixedArity = " max-fixed-arity ";") - (emits name ".cljs$lang$applyTo = ") + (emitln mname ".cljs$lang$maxFixedArity = " max-fixed-arity ";") + (emits mname ".cljs$lang$applyTo = ") (emit-apply-to (assoc f :name name)) (emitln ";") - (emitln name ".cljs$lang$arity$variadic = " delegate-name ";") - (emitln "return " name ";") + (emitln mname ".cljs$lang$arity$variadic = " delegate-name ";") + (emitln "return " mname ";") (emitln "})()")))) (defmethod emit :fn [{:keys [name env methods max-fixed-arity variadic recur-frames loop-lets]}] ;;fn statements get erased, serve no purpose and can pollute scope if named (when-not (= :statement (:context env)) - (let [loop-locals (seq (concat - (mapcat :names (filter #(and % @(:flag %)) recur-frames)) - (mapcat :names loop-lets)))] + (let [loop-locals (->> (concat (mapcat :names (filter #(and % @(:flag %)) recur-frames)) + (mapcat :names loop-lets)) + (map munge) + seq)] (when loop-locals (when (= :return (:context env)) (emits "return ")) @@ -569,26 +561,27 @@ (emit-fn-method (assoc (first methods) :name name))) (let [has-name? (and name true) name (or name (gensym)) - maxparams (apply max-key count (map :params methods)) + mname (munge name) + maxparams (map munge (apply max-key count (map :params methods))) mmap (into {} (map (fn [method] - [(symbol (str name "__" (count (:params method)))) + [(munge (symbol (str mname "__" (count (:params method))))) method]) methods)) ms (sort-by #(-> % second :params count) (seq mmap))] (when (= :return (:context env)) (emits "return ")) (emitln "(function() {") - (emitln "var " name " = null;") + (emitln "var " mname " = null;") (doseq [[n meth] ms] (emits "var " n " = ") (if (:variadic meth) (emit-variadic-fn-method meth) (emit-fn-method meth)) (emitln ";")) - (emitln name " = function(" (comma-sep (if variadic - (concat (butlast maxparams) ['var_args]) - maxparams)) "){") + (emitln mname " = function(" (comma-sep (if variadic + (concat (butlast maxparams) ['var_args]) + maxparams)) "){") (when variadic (emitln "var " (last maxparams) " = var_args;")) (emitln "switch(arguments.length){") @@ -607,15 +600,15 @@ (emitln "throw('Invalid arity: ' + arguments.length);") (emitln "};") (when variadic - (emitln name ".cljs$lang$maxFixedArity = " max-fixed-arity ";") - (emitln name ".cljs$lang$applyTo = " (some #(let [[n m] %] (when (:variadic m) n)) ms) ".cljs$lang$applyTo;")) + (emitln mname ".cljs$lang$maxFixedArity = " max-fixed-arity ";") + (emitln mname ".cljs$lang$applyTo = " (some #(let [[n m] %] (when (:variadic m) n)) ms) ".cljs$lang$applyTo;")) (when has-name? (doseq [[n meth] ms] (let [c (count (:params meth))] (if (:variadic meth) - (emitln name ".cljs$lang$arity$variadic = " n ".cljs$lang$arity$variadic;") - (emitln name ".cljs$lang$arity$" c " = " n ";"))))) - (emitln "return " name ";") + (emitln mname ".cljs$lang$arity$variadic = " n ".cljs$lang$arity$variadic;") + (emitln mname ".cljs$lang$arity$" c " = " n ";"))))) + (emitln "return " mname ";") (emitln "})()"))) (when loop-locals (emitln ";})(" (comma-sep loop-locals) "))"))))) @@ -641,7 +634,7 @@ (emit-block subcontext statements ret)) (emits "}") (when name - (emits "catch (" name "){") + (emits "catch (" (munge name) "){") (when catch (let [{:keys [statements ret]} catch] (emit-block subcontext statements ret))) @@ -663,7 +656,7 @@ (let [context (:context env)] (when (= :expr context) (emits "(function (){")) (doseq [{:keys [name init]} bindings] - (emitln "var " name " = " init ";")) + (emitln "var " (munge name) " = " init ";")) (when loop (emitln "while(true){")) (emit-block (if (= :expr context) :return context) statements ret) (when loop @@ -680,7 +673,7 @@ (dotimes [i (count exprs)] (emitln "var " (temps i) " = " (exprs i) ";")) (dotimes [i (count exprs)] - (emitln (names i) " = " (temps i) ";")) + (emitln (munge (names i)) " = " (temps i) ";")) (emitln "continue;") (emitln "}"))) @@ -689,7 +682,7 @@ (let [context (:context env)] (when (= :expr context) (emits "(function (){")) (doseq [{:keys [name init]} bindings] - (emitln "var " name " = " init ";")) + (emitln "var " (munge name) " = " init ";")) (emit-block (if (= :expr context) :return context) statements ret) (when (= :expr context) (emits "})()")))) @@ -699,7 +692,7 @@ fn? (and *cljs-static-fns* (not (:dynamic info)) (:fn-var info)) - opt-not? (and (= (:name-sym info) 'cljs.core/not) + opt-not? (and (= (:name info) 'cljs.core/not) (= (infer-tag (first (:args expr))) 'boolean)) ns (:ns info) js? (= ns 'js) @@ -724,7 +717,7 @@ ;; direct dispatch to variadic case (and variadic? (> arity mfa)) [(update-in f [:info :name] - (fn [name] (symbol (str name ".cljs$lang$arity$variadic")))) + (fn [name] (symbol (str (munge name) ".cljs$lang$arity$variadic")))) {:max-fixed-arity mfa}] ;; direct dispatch to specific arity case @@ -732,7 +725,7 @@ (let [arities (map count mps)] (if (some #{arity} arities) [(update-in f [:info :name] - (fn [name] (symbol (str name ".cljs$lang$arity$" arity)))) nil] + (fn [name] (symbol (str (munge name) ".cljs$lang$arity$" arity)))) nil] [f nil])))) [f nil])] (emit-wrap env @@ -784,7 +777,7 @@ (emitln "/**") (emitln "* @constructor") (emitln "*/") - (emitln t " = (function (" (comma-sep (map str fields)) "){") + (emitln (munge t) " = (function (" (comma-sep fields) "){") (doseq [fld fields] (emitln "this." fld " = " fld ";")) (doseq [[pno pmask] pmasks] @@ -802,7 +795,7 @@ (emitln "* @param {*=} __meta ") (emitln "* @param {*=} __extmap") (emitln "*/") - (emitln t " = (function (" (comma-sep (map str fields)) "){") + (emitln (munge t) " = (function (" (comma-sep fields) "){") (doseq [fld fields] (emitln "this." fld " = " fld ";")) (doseq [[pno pmask] pmasks] @@ -824,8 +817,8 @@ [{:keys [target field method args env]}] (emit-wrap env (if field - (emits target "." field) - (emits target "." method "(" + (emits target "." (munge field #{})) + (emits target "." (munge method #{}) "(" (comma-sep args) ")")))) @@ -897,9 +890,8 @@ (rest tail)) name (first cblock) locals (:locals catchenv) - mname (when name (munge name)) locals (if name - (assoc locals name {:name mname}) + (assoc locals name {:name name}) locals) catch (when cblock (analyze-block (assoc catchenv :locals locals) (rest cblock))) @@ -910,7 +902,7 @@ {:env env :op :try* :form form :try try :finally finally - :name mname + :name name :catch catch :children (vec (mapcat block-children [try catch finally]))})) @@ -939,7 +931,7 @@ (swap! namespaces update-in [ns-name :excludes] conj sym) (update-in env [:ns :excludes] conj sym)) env) - name (munge (:name (resolve-var (dissoc env :locals) sym))) + name (:name (resolve-var (dissoc env :locals) sym)) init-expr (when (contains? args :init) (disallowing-recur (analyze (assoc env :context :expr) (:init args) sym))) @@ -987,14 +979,14 @@ (uniqify r))))] (let [params (first meth) variadic (boolean (some '#{&} params)) - params (uniqify (remove '#{&} params)) + params (vec (uniqify (remove '#{&} params))) fixed-arity (count (if variadic (butlast params) params)) body (next meth) - locals (reduce (fn [m name] (assoc m name {:name (munge name)})) locals params) - recur-frame {:names (vec (map munge params)) :flag (atom nil)} + locals (reduce (fn [m name] (assoc m name {:name name})) locals params) + recur-frame {:names params :flag (atom nil)} block (binding [*recur-frames* (cons recur-frame *recur-frames*)] (analyze-block (assoc env :context :return :locals locals) body))] - (merge {:env env :variadic variadic :params (map munge params) :max-fixed-arity fixed-arity + (merge {:env env :variadic variadic :params params :max-fixed-arity fixed-arity :gthis gthis :recurs @(:flag recur-frame)} block)))) @@ -1005,14 +997,13 @@ [name (seq args)]) ;;turn (fn [] ...) into (fn ([]...)) meths (if (vector? (first meths)) (list meths) meths) - mname (when name (munge name)) locals (:locals env) - locals (if name (assoc locals name {:name mname}) locals) + locals (if name (assoc locals name {:name name}) locals) fields (-> form meta ::fields) gthis (and fields (gensym "this__")) locals (reduce (fn [m fld] (assoc m fld - {:name (symbol (str gthis "." (munge fld))) + {:name (symbol (str gthis "." fld)) :field true :mutable (-> fld meta :mutable) :tag (-> fld meta :tag)})) @@ -1022,7 +1013,7 @@ methods (map #(analyze-fn-method menv locals % gthis) meths) max-fixed-arity (apply max (map :max-fixed-arity methods)) variadic (boolean (some :variadic methods)) - locals (if name (assoc locals name {:name mname :fn-var true + locals (if name (assoc locals name {:name name :fn-var true :variadic variadic :max-fixed-arity max-fixed-arity :method-params (map :params methods)})) @@ -1032,7 +1023,7 @@ (map #(analyze-fn-method menv locals % gthis) meths) methods)] ;;todo - validate unique arities, at most one variadic, variadic takes max required args - {:env env :op :fn :form form :name mname :methods methods :variadic variadic + {:env env :op :fn :form form :name name :methods methods :variadic variadic :recur-frames *recur-frames* :loop-lets *loop-lets* :jsdoc [(when variadic "@param {...*} var_args")] :max-fixed-arity max-fixed-arity @@ -1044,7 +1035,7 @@ (assert (and (vector? bindings) (even? (count bindings))) "bindings must be vector of even number of elements") (let [n->fexpr (into {} (map (juxt first second) (partition 2 bindings))) names (keys n->fexpr) - n->gsym (into {} (map (juxt identity #(gensym (str (munge %) "__"))) names)) + n->gsym (into {} (map (juxt identity #(gensym (str % "__"))) names)) gsym->n (into {} (map (juxt n->gsym identity) names)) context (:context env) bes (reduce (fn [bes n] @@ -1093,7 +1084,7 @@ (do (assert (not (or (namespace name) (.contains (str name) "."))) (str "Invalid local name: " name)) (let [init-expr (analyze env init) - be {:name (gensym (str (munge name) "__")) + be {:name (gensym (str name "__")) :init init-expr :tag (or (-> name meta :tag) (-> init-expr :tag) @@ -1260,7 +1251,7 @@ (defmethod parse 'deftype* [_ env [_ tsym fields pmasks :as form] _] - (let [t (munge (:name (resolve-var (dissoc env :locals) tsym)))] + (let [t (:name (resolve-var (dissoc env :locals) tsym))] (swap! namespaces update-in [(-> env :ns :name) :defs tsym] (fn [m] (let [m (assoc (or m {}) @@ -1275,7 +1266,7 @@ (defmethod parse 'defrecord* [_ env [_ tsym fields pmasks :as form] _] - (let [t (munge (:name (resolve-var (dissoc env :locals) tsym)))] + (let [t (:name (resolve-var (dissoc env :locals) tsym))] (swap! namespaces update-in [(-> env :ns :name) :defs tsym] (fn [m] (let [m (assoc (or m {}) :name t)] @@ -1290,18 +1281,6 @@ (def ^:private property-symbol? #(boolean (and (symbol? %) (re-matches #"^-.*" (name %))))) -(defn- munge-not-reserved [meth] - (if-not (js-reserved (str meth)) - (munge meth) - meth)) - -(defn- clean-symbol - [sym] - (symbol - (if (property-symbol? sym) - (-> sym name (.substring 1) munge-not-reserved) - (-> sym name munge-not-reserved)))) - (defn- classify-dot-form [[target member args]] [(cond (nil? target) ::error @@ -1319,7 +1298,7 @@ ;; (. (...) -p) (defmethod build-dot-form [::expr ::property ()] [[target prop _]] - {:dot-action ::access :target target :field (clean-symbol prop)}) + {:dot-action ::access :target target :field (-> prop name (.substring 1) symbol)}) ;; (. o -p ) (defmethod build-dot-form [::expr ::property ::list] @@ -1331,8 +1310,8 @@ compilation." [target meth args] (if (symbol? meth) - {:dot-action ::call :target target :method (munge-not-reserved meth) :args args} - {:dot-action ::call :target target :method (munge-not-reserved (first meth)) :args args})) + {:dot-action ::call :target target :method meth :args args} + {:dot-action ::call :target target :method (first meth) :args args})) ;; (. o m 1 2) (defmethod build-dot-form [::expr ::symbol ::expr] diff --git a/src/cljs/cljs/core.cljs b/src/cljs/cljs/core.cljs index b6bf733..830ff82 100644 --- a/src/cljs/cljs/core.cljs +++ b/src/cljs/cljs/core.cljs @@ -6386,7 +6386,7 @@ reduces them without incurring seq initialization" current value of the atom is identical to oldval. Returns true if set happened, else false." [a oldval newval] - (if (= a.state oldval) + (if (= (.-state a) oldval) (do (reset! a newval) true) false)) -- 1.7.9.1