Touch up Sean Grove's Keyword patch

Tweak analyzer/compiler bits and leave notes about what should be changed
in the near future. Changed to compiler so that the Keyword changes work
outside of advanced compilation, both for <= simple optimizations and
the REPL. Fix a bug around keyword as fns <= simple optimizations.

Add new compiler option - :optimize-constants. This is only enabled in
advanced optimizations or if explicitly enabled.

Remove remaining hacks around keywords as strings.

BREAKING CHANGE: add keyword-identical?. There is no longer any
guarantee that keywords will be identical, you must use
keyword-identical? Change the tests in array-map, hash mapss, and
defrecord to account for this change. Remove tests with bad assumptions.

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})

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])

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)

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)