Refactor has-extern? / js-tag (#246)

* fix up tests so they don't throw if no warnings
* resolve-extern, which can be used by both has-extern? and js-tag, returns both resolved prefix and var info
* remove various hacks around extern resolution (Number, Window, prototype etc.), resolve-extern handles everything
* undefined is a ref cycle, special case
* change normalize-js-tag so it marks the ctor prop
* add normalize-unresolved-prefix to fix up the cases we can't find
* add impl unit tests
* more unit test 
  - can finally resolve crypto.subtle, verify type inference as well
* add lift-tag-to-js helper
* in resolve-var add the ctor to the tag to track later, this also lets the extra information flow
* in analyze-dot check to see if the target is a constructor
  - if it is use that as tag instead, Function is not useful
* test assertion that we can figure out the return even if a extern js ctor is bound to a local
* add compiler test case for inferring return of Number.isNaN
* add non-ctor inference for array, string, boolean and number, will be useful later
* add js/isNaN test
* add isArray extern test
* don't return raised js/Foo types for boolean, number, string
* remove ^boolean hint from array? ass test
* remove hint for make-array, add test
* remove hints for isFinite and isSafeInteger, tests
* can infer distinct?, add test
* remove various ^boolean cases no longer needed
* FIXME comments about dubious ^boolean cases
* move ^boolean hint from special-symbol? to contains? where it belongs, test case
* goog.object/containsKey type inference doesn't work for reason, leave a trail for later
* goog.string/contains does work, add test
* remove hint from NaN?
* FIXME note about re-matches, another dubious case of ^boolean hints

Author: swannodette

src/main/cljs/cljs/core.cljs

@@ -243,7 +243,7 @@
   [x]
   (coercive-= x nil))
 
-(defn ^boolean array?
+(defn array?
   "Returns true if x is a JavaScript array."
   [x]
   (if (identical? *target* "nodejs")
@@ -444,7 +444,7 @@
 
 (declare apply)
 
-(defn ^array make-array
+(defn make-array
   "Construct a JavaScript array of the specified dimensions. Accepts ignored
   type argument for compatibility with Clojure. Note that there is no efficient
   way to allocate multi-dimensional arrays in JavaScript; as such, this function
@@ -1055,8 +1055,8 @@
     (bit-xor (-hash o) 0)
 
     (number? o)
-    (if ^boolean (js/isFinite o)
-      (if-not ^boolean (.isSafeInteger js/Number o)
+    (if (js/isFinite o)
+      (if-not (.isSafeInteger js/Number o)
         (hash-double o)
         (js-mod (Math/floor o) 2147483647))
       (case o
@@ -2355,7 +2355,7 @@ reduces them without incurring seq initialization"
   "Returns true if n is a JavaScript number with no decimal part."
   [n]
   (and (number? n)
-       (not ^boolean (js/isNaN n))
+       (not (js/isNaN n))
        (not (identical? n js/Infinity))
        (== (js/parseFloat n) (js/parseInt n 10))))
 
@@ -2432,7 +2432,7 @@ reduces them without incurring seq initialization"
   (or (identical? x js/Number.POSITIVE_INFINITY)
       (identical? x js/Number.NEGATIVE_INFINITY)))
 
-(defn contains?
+(defn ^boolean contains?
   "Returns true if key is present in the given collection, otherwise
   returns false.  Note that for numerically indexed collections like
   vectors and arrays, this tests if the numeric key is within the
@@ -2462,12 +2462,12 @@ reduces them without incurring seq initialization"
             (contains? coll k))
       (MapEntry. k (get coll k) nil))))
 
-(defn ^boolean distinct?
+(defn distinct?
   "Returns true if no two of the arguments are ="
   ([x] true)
   ([x y] (not (= x y)))
   ([x y & more]
-     (if (not (= x y))
+   (if (not (= x y))
      (loop [s #{x y} xs more]
        (let [x (first xs)
              etc (next xs)]
@@ -8351,6 +8351,7 @@ reduces them without incurring seq initialization"
           (if (identical? node root)
             nil
             (set! root node))
+          ;; FIXME: can we figure out something better here?
           (if ^boolean (.-val added-leaf?)
             (set! count (inc count)))
           tcoll))
@@ -8372,6 +8373,7 @@ reduces them without incurring seq initialization"
             (if (identical? node root)
               nil
               (set! root node))
+            ;; FIXME: can we figure out something better here?
             (if ^boolean (.-val removed-leaf?)
               (set! count (dec count)))
             tcoll)))
@@ -10562,6 +10564,7 @@ reduces them without incurring seq initialization"
         (pr-writer (meta obj) writer opts)
         (-write writer " "))
       (cond
+        ;; FIXME: can we figure out something better here?
         ;; handle CLJS ctors
         ^boolean (.-cljs$lang$type obj)
         (.cljs$lang$ctorPrWriter obj obj writer opts)
@@ -10576,7 +10579,7 @@ reduces them without incurring seq initialization"
         (number? obj)
         (-write writer
           (cond
-            ^boolean (js/isNaN obj) "##NaN"
+            (js/isNaN obj) "##NaN"
             (identical? obj js/Number.POSITIVE_INFINITY) "##Inf"
             (identical? obj js/Number.NEGATIVE_INFINITY) "##-Inf"
             :else (str_ obj)))
@@ -11942,7 +11945,7 @@ reduces them without incurring seq initialization"
   (fn [x y]
     (cond (pred x y) -1 (pred y x) 1 :else 0)))
 
-(defn ^boolean special-symbol?
+(defn special-symbol?
   "Returns true if x names a special form"
   [x]
   (contains?
@@ -12175,6 +12178,8 @@ reduces them without incurring seq initialization"
   Object
   (findInternedVar [this sym]
     (let [k (munge (str_ sym))]
+      ;; FIXME: this shouldn't need ^boolean due to GCL library analysis,
+      ;; but not currently working
       (when ^boolean (gobject/containsKey obj k)
         (let [var-sym (symbol (str_ name) (str_ sym))
               var-meta {:ns this}]
@@ -12268,7 +12273,7 @@ reduces them without incurring seq initialization"
   (when (nil? NS_CACHE)
     (set! NS_CACHE (atom {})))
   (let [ns-str (str_ ns)
-        ns (if (not ^boolean (gstring/contains ns-str "$macros"))
+        ns (if (not (gstring/contains ns-str "$macros"))
              (symbol (str_ ns-str "$macros"))
              ns)
         the-ns (get @NS_CACHE ns)]
@@ -12292,7 +12297,7 @@ reduces them without incurring seq initialization"
   [x]
   (instance? goog.Uri x))
 
-(defn ^boolean NaN?
+(defn NaN?
   "Returns true if num is NaN, else false"
   [val]
   (js/isNaN val))
@@ -12321,6 +12326,7 @@ reduces them without incurring seq initialization"
   [s]
   (if (string? s)
     (cond
+      ;; FIXME: another cases worth thinking about
       ^boolean (re-matches #"[\x00-\x20]*[+-]?NaN[\x00-\x20]*" s) ##NaN
       ^boolean (re-matches
                 #"[\x00-\x20]*[+-]?(Infinity|((\d+\.?\d*|\.\d+)([eE][+-]?\d+)?)[dDfF]?)[\x00-\x20]*"

src/main/clojure/cljs/analyzer.cljc

@@ -980,10 +980,10 @@
 (defn normalize-js-tag [x]
   ;; if not 'js, assume constructor
   (if-not (= 'js x)
-    (with-meta 'js
-      {:prefix (conj (->> (string/split (name x) #"\.")
-                       (map symbol) vec)
-                 'prototype)})
+    (let [props  (->> (string/split (name x) #"\.") (map symbol))
+          [xs y] ((juxt butlast last) props)]
+      (with-meta 'js
+        {:prefix (vec (concat xs [(with-meta y {:ctor true})]))}))
     x))
 
 (defn ->type-set
@@ -1030,46 +1030,89 @@
     boolean  Boolean
     symbol   Symbol})
 
-(defn has-extern?*
+(defn resolve-extern
+  "Given a foreign js property list, return a resolved js property list and the
+  extern var info"
+  ([pre]
+   (resolve-extern pre (get-externs)))
   ([pre externs]
-   (let [pre (if-some [me (find
-                            (get-in externs '[Window prototype])
-                            (first pre))]
-               (if-some [tag (-> me first meta :tag)]
-                 (into [tag 'prototype] (next pre))
-                 pre)
-               pre)]
-     (has-extern?* pre externs externs)))
-  ([pre externs top]
+   (resolve-extern pre externs externs {:resolved []}))
+  ([pre externs top ret]
    (cond
-     (empty? pre) true
+     (empty? pre) ret
      :else
      (let [x  (first pre)
            me (find externs x)]
        (cond
-         (not me) false
+         (not me) nil
          :else
          (let [[x' externs'] me
-               xmeta (meta x')]
-           (if (and (= 'Function (:tag xmeta)) (:ctor xmeta))
-             (or (has-extern?* (into '[prototype] (next pre)) externs' top)
-                 (has-extern?* (next pre) externs' top)
-                 ;; check base type if it exists
-                 (when-let [super (:super xmeta)]
-                   (has-extern?* (into [super] (next pre)) externs top)))
-             (recur (next pre) externs' top))))))))
+               info' (meta x')
+               ret (cond-> ret
+                     ;; we only care about var info for the last property
+                     ;; also if we already added it, don't override it
+                     ;; because we're now resolving type information
+                     ;; not instance information anymore
+                     ;; i.e. [console] -> [Console] but :tag is Console _not_ Function vs.
+                     ;; [console log] -> [Console prototype log] where :tag is Function
+                     (and (empty? (next pre))
+                          (not (contains? ret :info)))
+                     (assoc :info info'))]
+           ;; handle actual occurrences of types, i.e. `Console`
+           (if (and (or (:ctor info') (:iface info')) (= 'Function (:tag info')))
+             (or
+               ;; then check for "static" property
+               (resolve-extern (next pre) externs' top
+                 (update ret :resolved conj x))
+
+               ;; first look for a property on the prototype
+               (resolve-extern (into '[prototype] (next pre)) externs' top
+                 (update ret :resolved conj x))
+
+               ;; finally check the super class if there is one
+               (when-let [super (:super info')]
+                 (resolve-extern (into [super] (next pre)) externs top
+                   (assoc ret :resolved []))))
+
+             (or
+               ;; If the tag of the property isn't Function or undefined,
+               ;; try to resolve it similar to the super case above,
+               ;; this handles singleton cases like `console`
+               (let [tag (:tag info')]
+                 (when (and tag (not (contains? '#{Function undefined} tag)))
+                   ;; check prefix first, during cljs.externs parsing we always generate prefixes
+                   ;; for tags because of types like webCrypto.Crypto
+                   (resolve-extern (into (or (-> tag meta :prefix) [tag]) (next pre)) externs top
+                     (assoc ret :resolved []))))
+
+               ;; assume static property
+               (recur (next pre) externs' top
+                 (update ret :resolved conj x))))))))))
+
+(defn normalize-unresolved-prefix
+  [pre]
+  (cond-> pre
+    (< 1 (count pre))
+    (cond->
+      (-> pre pop peek meta :ctor)
+      (-> pop
+        (conj 'prototype)
+        (conj (peek pre))))))
+
+(defn has-extern?*
+  [pre externs]
+  (boolean (resolve-extern pre externs)))
 
 (defn has-extern?
   ([pre]
    (has-extern? pre (get-externs)))
   ([pre externs]
    (or (has-extern?* pre externs)
-       (when (= 1 (count pre))
-         (let [x (first pre)]
-           (or (get-in externs (conj '[Window prototype] x))
-               (get-in externs (conj '[Number] x)))))
        (-> (last pre) str (string/starts-with? "cljs$")))))
 
+(defn lift-tag-to-js [tag]
+  (symbol "js" (str (alias->type tag tag))))
+
 (defn js-tag
   ([pre]
    (js-tag pre :tag))
@@ -1078,12 +1121,13 @@
   ([pre tag-type externs]
    (js-tag pre tag-type externs externs))
   ([pre tag-type externs top]
-   (when-let [[p externs' :as me] (find externs (first pre))]
-     (let [tag (-> p meta tag-type)]
-       (if (= (count pre) 1)
-         (when tag (symbol "js" (str (alias->type tag tag))))
-         (or (js-tag (next pre) tag-type externs' top)
-             (js-tag (into '[prototype] (next pre)) tag-type (get top tag) top)))))))
+   (when-let [tag (get-in (resolve-extern pre externs) [:info tag-type])]
+     (case tag
+       ;; don't lift these, analyze-dot will raise them for analysis
+       ;; representing these types as js/Foo is a hassle as it widens the
+       ;; return types unnecessarily i.e. #{boolean js/Boolean}
+       (boolean number string) tag
+       (lift-tag-to-js tag)))))
 
 (defn dotted-symbol? [sym]
   (let [s (str sym)]
@@ -1274,8 +1318,9 @@
                (assoc shadowed-by-local :op :local))
 
            :else
-           (let [pre (->> (string/split (name sym) #"\.") (map symbol) vec)]
-             (when (and (not (has-extern? pre))
+           (let [pre (->> (string/split (name sym) #"\.") (map symbol) vec)
+                 res (resolve-extern (->> (string/split (name sym) #"\.") (map symbol) vec))]
+             (when (and (not res)
                         ;; ignore exists? usage
                         (not (-> sym meta ::no-resolve)))
                (swap! env/*compiler* update-in
@@ -1284,10 +1329,12 @@
                {:name sym
                 :op :js-var
                 :ns   'js
-                :tag  (with-meta (or (js-tag pre) (:tag (meta sym)) 'js) {:prefix pre})}
+                :tag  (with-meta (or (js-tag pre) (:tag (meta sym)) 'js)
+                        {:prefix pre
+                         :ctor   (-> res :info :ctor)})}
                (when-let [ret-tag (js-tag pre :ret-tag)]
                  {:js-fn-var true
-                  :ret-tag ret-tag})))))
+                  :ret-tag   ret-tag})))))
        (let [s  (str sym)
              lb (handle-symbol-local sym (get locals sym))
              current-ns (-> env :ns :name)]
@@ -2585,12 +2632,12 @@
      :children [:expr]}))
 
 (def js-prim-ctor->tag
-  '{js/Object object
-    js/String string
-    js/Array array
-    js/Number number
+  '{js/Object   object
+    js/String   string
+    js/Array    array
+    js/Number   number
     js/Function function
-    js/Boolean boolean})
+    js/Boolean  boolean})
 
 (defn prim-ctor?
   "Test whether a tag is a constructor for a JS primitive"
@@ -3543,13 +3590,25 @@
                  (list* '. dot-form) " with classification "
                  (classify-dot-form dot-form))))))
 
+;; this only for a smaller set of types that we want to infer
+;; we don't generally want to consider function for example, these
+;; specific cases are ones we either try to optimize or validate
+(def ^{:private true}
+  tag->js-prim-ctor
+  '{string   js/String
+    array    js/Array
+    number   js/Number
+    boolean  js/Boolean})
+
 (defn analyze-dot [env target field member+ form]
   (let [v [target field member+]
         {:keys [dot-action target method field args]} (build-dot-form v)
         enve       (assoc env :context :expr)
         targetexpr (analyze enve target)
         form-meta  (meta form)
-        target-tag (:tag targetexpr)
+        target-tag (as-> (:tag targetexpr) $
+                     (or (some-> $ meta :ctor lift-tag-to-js)
+                         (tag->js-prim-ctor $ $)))
         prop       (or field method)
         tag        (or (:tag form-meta)
                        (and (js-tag? target-tag)
@@ -3581,7 +3640,8 @@
       (let [pre (-> tag meta :prefix)]
         (when-not (has-extern? pre)
           (swap! env/*compiler* update-in
-            (into [::namespaces (-> env :ns :name) :externs] pre) merge {}))))
+            (into [::namespaces (-> env :ns :name) :externs]
+              (normalize-unresolved-prefix pre)) merge {}))))
     (case dot-action
       ::access (let [children [:target]]
                  {:op :host-field

src/main/clojure/cljs/compiler.cljc

@@ -641,7 +641,8 @@
 
 (defn safe-test? [env e]
   (let [tag (ana/infer-tag env e)]
-    (or (#{'boolean 'seq} tag) (truthy-constant? e))))
+    (or ('#{boolean seq} (ana/js-prim-ctor->tag tag tag))
+        (truthy-constant? e))))
 
 (defmethod emit* :if
   [{:keys [test then else env unchecked]}]