CLJS-2866: Predicate-induced type inference

Look for if tests that look like the simple application of a predicate
to a local, and in that case, map certain predicates to the tags that
satisfying that predicate implies. For example a (string? x) test
implies that x has the tag string in the then branch of an if.

Likewise check for the use of satisfies? and instance? and induce
tags accordingly based on the type argument.

For core predicates that delegate to satisfies? or instance?,
we have hard-coded entries in the table that essentially cause things
to behave as if the predicate were inlined. For example, (counted? x)
behaves just like (satisfies? ICounted x).

We only induce tags if no tag previously exists (or a tag exists but
it is the special any tag.) This ensures that we don't override type
hints, or generally revise existing logic. (We really only induce a tag
as a last resort.)

Arrange the code so that we can add more complicated induced tags in
the future (perhaps allowing for logical connectives in the test, for
example.)

Author: mfikes

src/main/cljs/cljs/core.cljs

@@ -9960,7 +9960,7 @@ reduces them without incurring seq initialization"
 
         ; Use the new, more efficient, IPrintWithWriter interface when possible.
         (satisfies? IPrintWithWriter obj)
-        (-pr-writer obj writer opts)
+        (-pr-writer ^any obj writer opts)
 
         (or (true? obj) (false? obj))
         (-write writer (str obj))

src/main/clojure/cljs/analyzer.cljc

@@ -68,6 +68,11 @@
   "The namespace of the constants table as a symbol."
   'cljs.core.constants)
 
+(def ^:private identity-counter (atom 0))
+
+(defn- add-identity [m]
+  (assoc m :identity (swap! identity-counter inc)))
+
 #?(:clj
    (def transit-read-opts
      (try
@@ -1440,14 +1445,122 @@
      :form form}
     (var-ast env sym)))
 
+(def ^:private predicate->tag
+  '{
+    ;; Base values
+    cljs.core/nil?            clj-nil
+    cljs.core/undefined?      clj-nil
+    cljs.core/false?          boolean
+    cljs.core/true?           boolean
+    cljs.core/zero?           number
+    cljs.core/infinite?       number
+
+    ;; Base types
+    cljs.core/boolean?        boolean
+    cljs.core/string?         string
+    cljs.core/char?           string
+    cljs.core/number?         number
+    cljs.core/integer?        number
+    cljs.core/float?          number
+    cljs.core/double?         number
+    cljs.core/array?          array
+    cljs.core/seq?            seq
+
+    ;; JavaScript types
+    cljs.core/regexp?         js/RegExp
+
+    ;; Types
+    cljs.core/keyword?        cljs.core/Keyword
+    cljs.core/var?            cljs.core/Var
+    cljs.core/symbol?         cljs.core/Symbol
+    cljs.core/volatile?       cljs.core/Volatile
+    cljs.core/delay?          cljs.core/Delay
+    cljs.core/reduced?        cljs.core/Reduced
+
+    ;; Protocols
+    cljs.core/map-entry?      cljs.core/IMapEntry
+    cljs.core/reversible?     cljs.core/IReversible
+    cljs.core/uuid?           cljs.core/IUUID
+    cljs.core/tagged-literal? cljs.core/ITaggedLiteral
+    cljs.core/iterable?       cljs.core/IIterable
+    cljs.core/cloneable?      cljs.core/ICloneable
+    cljs.core/inst?           cljs.core/Inst
+    cljs.core/counted?        cljs.core/ICounted
+    cljs.core/indexed?        cljs.core/IIndexed
+    cljs.core/coll?           cljs.core/ICollection
+    cljs.core/set?            cljs.core/ISet
+    cljs.core/associative?    cljs.core/IAssociative
+    cljs.core/ifind?          cljs.core/IFind
+    cljs.core/sequential?     cljs.core/ISequential
+    cljs.core/sorted?         cljs.core/ISorted
+    cljs.core/reduceable      cljs.core/IReduce
+    cljs.core/map?            cljs.core/IMap
+    cljs.core/list?           cljs.core/IList
+    cljs.core/record?         cljs.core/IRecord
+    cljs.core/vector?         cljs.core/IVector
+    cljs.core/chunked-seq?    cljs.core/IChunkedSeq
+    cljs.core/ifn?            cljs.core/IFn
+
+    ;; Composites
+    cljs.core/seqable?        #{cljs.core/ISeqable array string}
+    cljs.core/ident?          #{cljs.core/Keyword cljs.core/Symbol}
+    })
+
+(defn- simple-predicate-induced-tag
+  "Look for a predicate-induced tag when the test expression is a simple
+   application of a predicate to a local, as in (string? x)."
+  [env test]
+  (when (and (list? test)
+             (== 2 (count test))
+             (every? symbol? test))
+    (let [analyzed-fn (no-warn (analyze (assoc env :context :expr) (first test)))]
+      (when (= :var (:op analyzed-fn))
+        (when-let [tag (predicate->tag (:name analyzed-fn))]
+          (let [sym (last test)]
+            (when (and (nil? (namespace sym))
+                       (get-in env [:locals sym]))
+              [sym tag])))))))
+
+(defn- type-check-induced-tag
+  "Look for a type-check-induced tag when the test expression is the use of
+   satisfies? or instance? on a local, as in (satisfies? ICounted x)."
+  [env test]
+  (when (and (list? test)
+             (== 3 (count test))
+             (every? symbol? test))
+    (let [analyzed-fn (no-warn (analyze (assoc env :context :expr) (first test)))]
+      (when (= :var (:op analyzed-fn))
+        (when ('#{cljs.core/satisfies? cljs.core/instance?} (:name analyzed-fn))
+          (let [analyzed-type (no-warn (analyze (assoc env :context :expr) (second test)))
+                tag (:name analyzed-type)
+                sym (last test)]
+            (when (and (= :var (:op analyzed-type))
+                       (nil? (namespace sym))
+                       (get-in env [:locals sym]))
+              [sym tag])))))))
+
+(defn- add-predicate-induced-tags
+  "Looks at the test and adds any tags which are induced by virtue
+  of the predicate being satisfied. For exmaple in (if (string? x) x :bar)
+  the local x in the then branch must be of string type."
+  [env test]
+  (let [[local tag] (or (simple-predicate-induced-tag env test)
+                        (type-check-induced-tag env test))]
+    (cond-> env
+      local (update-in [:locals local :tag] (fn [prev-tag]
+                                              (if (or (nil? prev-tag)
+                                                      (= 'any prev-tag))
+                                                tag
+                                                prev-tag))))))
+
 (defmethod parse 'if
   [op env [_ test then else :as form] name _]
   (when (< (count form) 3)
     (throw (error env "Too few arguments to if")))
   (when (> (count form) 4)
    (throw (error env "Too many arguments to if")))
   (let [test-expr (disallowing-recur (analyze (assoc env :context :expr) test))
-        then-expr (allowing-redef (analyze env then))
+        then-expr (allowing-redef (analyze (add-predicate-induced-tags env test) then))
         else-expr (allowing-redef (analyze env else))]
     {:env env :op :if :form form
      :test test-expr :then then-expr :else else-expr
@@ -2105,7 +2218,8 @@
                         :variadic? (:variadic? init-expr)
                         :max-fixed-arity (:max-fixed-arity init-expr)
                         :method-params (map :params (:methods init-expr))})
-                     be)]
+                     be)
+                be (add-identity be)]
             (recur (conj bes be)
               (assoc-in env [:locals name] be)
               (next bindings))))

src/main/clojure/cljs/compiler.cljc

@@ -86,7 +86,7 @@
         :else d))))
 
 (defn hash-scope [s]
-  #?(:clj (System/identityHashCode s)
+  #?(:clj  (or (:identity s) (System/identityHashCode s))
      :cljs (hash-combine (-hash ^not-native (:name s))
              (shadow-depth s))))
 

src/test/cljs/cljs/inference_test.cljs

@@ -8,7 +8,7 @@
 
 (ns cljs.inference-test
   (:require-macros [cljs.inference-util])
-  (:require [cljs.test :refer [deftest]]
+  (:require [cljs.test :refer [deftest is]]
             [cljs.pprint]))
 
 (deftest test-cljs-2825
@@ -78,3 +78,13 @@
     (uuid? nil)
     (tagged-literal? nil)
     (cljs.pprint/float? nil)))
+
+(deftest cljs-2866-test
+  ;; Here we are testing that in the JavaScript emitted,
+  ;; the gensym generated for curr is being passed to dec
+  (is (zero? ((fn [x]
+                (while (pos? @x)
+                  (let [curr @x]
+                    (when (number? curr)
+                      (reset! x (dec curr)))))
+                @x) (atom 1)))))

src/test/clojure/cljs/analyzer_tests.clj

@@ -231,6 +231,44 @@
              (:tag (analyze test-env '(if x "foo" 1)))))
          '#{number string})))
 
+(deftest if-induced-inference
+  (is (= (a/no-warn
+           (e/with-compiler-env test-cenv
+             (:tag (a/analyze test-env '(let [x ^any []] (if (nil? x) x :kw))))))
+        '#{clj-nil cljs.core/Keyword}))
+  (is (= (a/no-warn
+           (e/with-compiler-env test-cenv
+             (:tag (a/analyze test-env '(let [x ^any []] (if (boolean? x) x :kw))))))
+        '#{boolean cljs.core/Keyword}))
+  (is (= (a/no-warn
+           (e/with-compiler-env test-cenv
+             (:tag (a/analyze test-env '(let [x ^any []] (if (number? x) x :kw))))))
+        '#{number cljs.core/Keyword}))
+  (is (= (a/no-warn
+           (e/with-compiler-env test-cenv
+             (:tag (a/analyze test-env '(let [x ^any []] (if (double? x) x :kw))))))
+        '#{number cljs.core/Keyword}))
+  (is (= (a/no-warn
+           (e/with-compiler-env test-cenv
+             (:tag (a/analyze test-env '(let [x ^any []] (if (float? x) x :kw))))))
+        '#{number cljs.core/Keyword}))
+  (is (= (a/no-warn
+           (e/with-compiler-env test-cenv
+             (:tag (a/analyze test-env '(let [x ^any []] (if (integer? x) x :kw))))))
+        '#{number cljs.core/Keyword}))
+  (is (= (a/no-warn
+           (e/with-compiler-env test-cenv
+             (:tag (a/analyze test-env '(let [x ^any []] (if (seq? x) x :kw))))))
+        '#{seq cljs.core/Keyword}))
+  (is (= (a/no-warn
+           (e/with-compiler-env test-cenv
+             (:tag (a/analyze test-env '(let [x ^any []] (if (array? x) x :kw))))))
+        '#{array cljs.core/Keyword}))
+  (is (= (a/no-warn
+           (e/with-compiler-env test-cenv
+             (:tag (a/analyze test-env '(let [x ^any []] (if (seqable? x) x :kw))))))
+        '#{cljs.core/ISeqable array string cljs.core/Keyword})))
+
 (deftest method-inference
   (is (= (e/with-compiler-env test-cenv
            (:tag (analyze test-env '(.foo js/bar))))