diff --git a/src/clj/cljs/analyzer.clj b/src/clj/cljs/analyzer.clj index e339975df5..4742a1e5a9 100644 --- a/src/clj/cljs/analyzer.clj +++ b/src/clj/cljs/analyzer.clj @@ -24,7 +24,7 @@ (def ^:dynamic *cljs-macros-is-classpath* true) (def -cljs-macros-loaded (atom false)) -(def ^:dynamic *real-keywords* true) +(def ^:dynamic *track-constants* false) (def ^:dynamic *constant-table* (atom {})) (def ^:dynamic *cljs-warnings* @@ -36,27 +36,25 @@ :fn-deprecated true :protocol-deprecated true}) -(def keyword_counter (atom 0)) +(def constant-counter (atom 0)) -(defn genid - "Returns a new symbol with a unique name. If a prefix string is - supplied, the name is prefix# where # is some unique number. If - prefix is not supplied, the prefix is 'K__'." - ([] (genid "K__")) - ([prefix-string] - (when (nil? keyword_counter) - (set! keyword_counter (atom 0))) - (symbol (str prefix-string (swap! keyword_counter inc))))) +(defn gen-constant-id [value] + (let [prefix (cond + (keyword? value) "constant$keyword$" + :else + (throw + (Exception. (str "constant type " (type value) " not supported"))))] + (symbol (str prefix (swap! constant-counter inc))))) (defn reset-constant-table! [] (reset! *constant-table* {})) -(defn register-constant! [k] +(defn register-constant! [val] (swap! *constant-table* - (fn [table] - (if (get table k) - table - (assoc table k (genid)))))) + (fn [table] + (if (get table val) + table + (assoc table val (gen-constant-id val)))))) (defonce namespaces (atom '{cljs.core {:name cljs.core} cljs.user {:name cljs.user}})) @@ -250,9 +248,10 @@ (defmacro disallowing-recur [& body] `(binding [*recur-frames* (cons nil *recur-frames*)] ~@body)) +;; TODO: move this logic out - David (defn analyze-keyword [env sym] - (when *real-keywords* + (when *track-constants* (register-constant! sym)) {:op :constant :env env :form sym}) diff --git a/src/clj/cljs/closure.clj b/src/clj/cljs/closure.clj index 8cdbeda0b1..ffb2535486 100644 --- a/src/clj/cljs/closure.clj +++ b/src/clj/cljs/closure.clj @@ -642,7 +642,7 @@ (:provides %) (:requires %)) (assoc :group (:group %))) required-js) - [(when ana/*real-keywords* + [(when ana/*track-constants* (let [url (to-url (str (output-directory opts) "/constants_table.js"))] (javascript-file nil url url ["constants-table"] ["cljs.core"] nil nil)))] required-cljs @@ -953,12 +953,17 @@ (or (and (= (opts :optimizations) :advanced)) (:static-fns opts) ana/*cljs-static-fns*) + ana/*track-constants* + (or (and (= (opts :optimizations) :advanced)) + (:optimize-constants opts) + ana/*track-constants*) ana/*cljs-warnings* (assoc ana/*cljs-warnings* :undeclared (true? (opts :warnings)))] (let [compiled (-compile source all-opts) ; Cause the constants table file to be written - const-table (when ana/*real-keywords* - (comp/emit-constants-table-to-file @ana/*constant-table* (str (output-directory all-opts) "/constants_table.js"))) + const-table (when ana/*track-constants* + (comp/emit-constants-table-to-file @ana/*constant-table* + (str (output-directory all-opts) "/constants_table.js"))) js-sources (concat (apply add-dependencies all-opts (concat (if (coll? compiled) compiled [compiled]) diff --git a/src/clj/cljs/compiler.clj b/src/clj/cljs/compiler.clj index ee4ea00357..2231b9623d 100644 --- a/src/clj/cljs/compiler.clj +++ b/src/clj/cljs/compiler.clj @@ -149,16 +149,6 @@ (let [[_ flags pattern] (re-find #"^(?:\(\?([idmsux]*)\))?(.*)" (str x))] (emits \/ (.replaceAll (re-matcher #"/" pattern) "\\\\/") \/ flags))) -(defmethod emit-constant clojure.lang.Keyword [x] - (if ana/*real-keywords* - (let [value (get @ana/*constant-table* x)] - (emits value)) - (emits \" "\\uFDD0" \: - (if (namespace x) - (str (namespace x) "/") "") - (name x) - \"))) - (def ^:const goog-hash-max 0x100000000) (defn goog-string-hash [s] @@ -167,6 +157,27 @@ (mod (+ (* 31 r) (int c)) goog-hash-max)) 0 s)) +(defmethod emit-constant clojure.lang.Keyword [x] + (if ana/*track-constants* + (let [value (get @ana/*constant-table* x)] + (emits "cljs.core." value)) + (let [ns (namespace x) + name (name x)] + (emits "new cljs.core.Keyword(") + (emit-constant ns) + (emits ",") + (emit-constant name) + (emits ",") + (emit-constant (if ns + (str ns "/" name) + name)) + (emits ",") + (emit-constant (+ (clojure.lang.Util/hashCombine + (unchecked-int (goog-string-hash ns)) + (unchecked-int (goog-string-hash name))) + 0x9e3779b9)) + (emits ")")))) + (defmethod emit-constant clojure.lang.Symbol [x] (let [ns (namespace x) name (name x) @@ -630,9 +641,7 @@ (emits (first args) "." pimpl "(" (comma-sep args) ")")) keyword? - (if ana/*real-keywords* - (emits f ".call(" (comma-sep (cons "null" args)) ")") - (emits "(new cljs.core.Keyword(" f ")).call(" (comma-sep (cons "null" args)) ")")) + (emits f ".call(" (comma-sep (cons "null" args)) ")") variadic-invoke (let [mfa (:max-fixed-arity variadic-invoke)] @@ -777,8 +786,10 @@ :provides [ns-name] :requires (if (= ns-name 'cljs.core) (set (vals deps)) - (set (remove nil? (conj (set (vals deps)) 'cljs.core - (when ana/*real-keywords* 'constants-table))))) + (set + (remove nil? + (conj (set (vals deps)) 'cljs.core + (when ana/*track-constants* 'constants-table))))) :file dest :source-file src :lines @*cljs-gen-line*} @@ -913,11 +924,13 @@ ;; files will be compiled to js. ) +;; TODO: needs fixing, table will include other things than keywords - David + (defn emit-constants-table [table] (doseq [[keyword value] table] - (let [ns (namespace keyword) + (let [ns (namespace keyword) name (name keyword)] - (emits value "=new cljs.core.Keyword(") + (emits "cljs.core." value " = new cljs.core.Keyword(") (emit-constant ns) (emits ",") (emit-constant name) diff --git a/src/clj/cljs/core.clj b/src/clj/cljs/core.clj index 806c16b88a..90a8e07dc1 100644 --- a/src/clj/cljs/core.clj +++ b/src/clj/cljs/core.clj @@ -753,7 +753,7 @@ `(~'-lookup [this# k#] (-lookup this# k# nil)) `(~'-lookup [this# ~ksym else#] (cond - ~@(mapcat (fn [f] [`(identical? ~ksym ~(keyword f)) f]) base-fields) + ~@(mapcat (fn [f] [`(keyword-identical? ~ksym ~(keyword f)) f]) base-fields) :else (get ~'__extmap ~ksym else#))) 'ICounted `(~'-count [this#] (+ ~(count base-fields) (count ~'__extmap))) @@ -766,7 +766,7 @@ entry#))) 'IAssociative `(~'-assoc [this# k# ~gs] - (condp identical? k# + (condp keyword-identical? k# ~@(mapcat (fn [fld] [(keyword fld) (list* `new tagname (replace {fld gs '__hash nil} fields))]) base-fields) diff --git a/src/cljs/cljs/core.cljs b/src/cljs/cljs/core.cljs index 5e290cdf87..9cf5978bc7 100644 --- a/src/cljs/cljs/core.cljs +++ b/src/cljs/cljs/core.cljs @@ -57,6 +57,8 @@ (def not-native nil) +(declare instance? Keyword) + (defn ^boolean identical? "Tests if 2 arguments are the same object" [x y] @@ -1192,8 +1194,6 @@ reduces them without incurring seq initialization" (defn ^boolean boolean [x] (if x true false)) -(declare keyword?) - (defn ^boolean ifn? [f] (or (fn? f) (satisfies? IFn f))) @@ -1745,33 +1745,19 @@ reduces them without incurring seq initialization" ;;;;;;;;;;;;;;;;;;;;;;;;;; basics ;;;;;;;;;;;;;;;;;; -(defn- str* - "Internal - do not use!" - ([] "") - ([x] (cond - (nil? x) "" - :else (. x (toString)))) - ([x & ys] - ((fn [sb more] - (if more - (recur (. sb (append (str* (first more)))) (next more)) - (str* sb))) - (gstring/StringBuffer. (str* x)) ys))) - (defn str "With no args, returns the empty string. With one arg x, returns x.toString(). (str nil) returns the empty string. With more than one arg, returns the concatenation of the str values of the args." ([] "") - ([x] (cond - (keyword? x) (str* ":" (.-fqn x)) - (nil? x) "" - :else (. x (toString)))) + ([x] (if (nil? x) + "" + (.toString x))) ([x & ys] ((fn [sb more] (if more (recur (. sb (append (str (first more)))) (next more)) - (str* sb))) + (.toString sb))) (gstring/StringBuffer. (str x)) ys))) (defn subs @@ -1785,14 +1771,7 @@ reduces them without incurring seq initialization" (defn format "Formats a string using goog.string.format." [fmt & args] - (let [args (map (fn [x] - (if (or (keyword? x) (symbol? x)) - (str x) - x)) - args)] - (apply gstring/format fmt args))) - -(declare keyword) + (apply gstring/format fmt args)) (defn- equiv-sequential "Assumes x is sequential. Returns true if x equals y, otherwise @@ -2039,7 +2018,8 @@ reduces them without incurring seq initialization" (deftype Keyword [ns name fqn ^:mutable _hash] Object - (toString [_] fqn) + (toString [_] (str ":" fqn)) + IEquiv (-equiv [_ other] (if (instance? Keyword other) @@ -2060,7 +2040,8 @@ reduces them without incurring seq initialization" ; This was checking if _hash == -1, should it stay that way? (if (nil? _hash) (do - (set! _hash (hash-combine (hash ns) (hash name))) + (set! _hash (+ (hash-combine (hash ns) (hash name)) + 0x9e3779b9)) _hash) _hash)) INamed @@ -2070,14 +2051,23 @@ reduces them without incurring seq initialization" (-pr-writer [o writer _] (-write writer (str ":" fqn)))) (defn ^boolean keyword? [x] - (js* "~{} instanceof ~{}" x Keyword)) + (instance? Keyword x)) + +(defn ^boolean keyword-identical? [x y] + (if (identical? x y) + true + (if (and (keyword? x) + (keyword? y)) + (identical? (.-fqn x) (.-fqn y)) + false))) (defn keyword "Returns a Keyword with the given namespace and name. Do not use : in the keyword strings, it will be added automatically." - ([name] (cond (keyword? name) (Keyword. nil name name nil) - (symbol? name) (Keyword. nil (cljs.core/name name) (cljs.core/name name) nil) - :else (Keyword. nil name name nil))) + ([name] (cond + (keyword? name)(Keyword. nil name name nil) + (symbol? name) (Keyword. nil (cljs.core/name name) (cljs.core/name name) nil) + :else (Keyword. nil name name nil))) ([ns name] (Keyword. ns name (str (when ns (str ns "/")) name) nil))) (defn- lazy-seq-value [lazy-seq] @@ -3980,6 +3970,17 @@ reduces them without incurring seq initialization" (nil? (aget arr i)) i :else (recur (+ i 2)))))) +(defn- array-map-index-of-keyword? [arr m k] + (let [len (alength arr) + kstr (.-fqn k)] + (loop [i 0] + (cond + (<= len i) -1 + (let [k' (aget arr i)] + (and (keyword? k') + (identical? kstr (.-fqn k')))) i + :else (recur (+ i 2)))))) + (defn- array-map-index-of-symbol? [arr m k] (let [len (alength arr) kstr (.-str k)] @@ -4010,6 +4011,8 @@ reduces them without incurring seq initialization" (defn- array-map-index-of [m k] (let [arr (.-arr m)] (cond + (keyword? k) (array-map-index-of-keyword? arr m k) + (or ^boolean (goog/isString k) (number? k)) (array-map-index-of-identical? arr m k) @@ -4291,9 +4294,10 @@ reduces them without incurring seq initialization" (declare create-inode-seq create-array-node-seq reset! create-node atom deref) (defn ^boolean key-test [key other] - (if ^boolean (goog/isString key) - (identical? key other) - (= key other))) + (cond + (identical? key other) true + (keyword-identical? key other) true + :else (= key other))) (defn- mask [hash shift] (bit-and (bit-shift-right-zero-fill hash shift) 0x01f)) @@ -6230,25 +6234,16 @@ reduces them without incurring seq initialization" [x] (if (satisfies? INamed x false) (-name ^not-native x) - (cond - (string? x) x - (keyword? x) - (let [i (.lastIndexOf x "/" (- (alength x) 2))] - (if (< i 0) - (subs x 2) - (subs x (inc i)))) - :else (throw (js/Error. (str "Doesn't support name: " x)))))) + (if (string? x) + x + (throw (js/Error. (str "Doesn't support name: " x)))))) (defn namespace "Returns the namespace String of a symbol or keyword, or nil if not present." [x] (if (satisfies? INamed x false) (-namespace ^not-native x) - (if (keyword? x) - (let [i (.lastIndexOf x "/" (- (alength x) 2))] - (when (> i -1) - (subs x 2 i))) - (throw (js/Error. (str "Doesn't support namespace: " x)))))) + (throw (js/Error. (str "Doesn't support namespace: " x))))) (defn zipmap "Returns a map with the keys mapped to the corresponding vals." @@ -6633,21 +6628,9 @@ reduces them without incurring seq initialization" (pr-sequential-writer writer pr-writer "#" opts obj) ^boolean (goog/isString obj) - (cond - (keyword? obj) - (do - (-write writer ":") - (when-let [nspc (namespace obj)] - (write-all writer (str nspc) "/")) - (-write writer (name obj))) - (symbol? obj) - (do - (when-let [nspc (namespace obj)] - (write-all writer (str nspc) "/")) - (-write writer (name obj))) - :else (if (:readably opts) - (-write writer (quote-string obj)) - (-write writer obj))) + (if (:readably opts) + (-write writer (quote-string obj)) + (-write writer obj)) (fn? obj) (write-all writer "#<" (str obj) ">") diff --git a/test/cljs/cljs/core_test.cljs b/test/cljs/cljs/core_test.cljs index 7f1af6a931..e30f6d44d9 100644 --- a/test/cljs/cljs/core_test.cljs +++ b/test/cljs/cljs/core_test.cljs @@ -1867,9 +1867,9 @@ ;; CLJS-493 (assert (nil? (get 42 :anything))) - (assert (identical? (get 42 :anything :not-found) :not-found)) + (assert (= (get 42 :anything :not-found) :not-found)) (assert (nil? (first (map get [42] [:anything])))) - (assert (identical? (first (map get [42] [:anything] [:not-found])) :not-found)) + (assert (= (first (map get [42] [:anything] [:not-found])) :not-found)) ;; CLJS-481