CLJS-2901: Return type inference for multi-arity & variadic fns

For the anonymous fn case simply handle the tagging of :methods in
cljs.analyzer/infer-type. This is enough for local fn invoke to be
be inferred correctly.

The top-level case is a bit trickier due to the fact that defn
is a ClojureScript macro that desugars before the compiler to ensure
that Closure cross module code motion can work. In this case add a
special case to cljs.analyzer/parse 'set!. If we have a top level
fn (:top-fn), use its metadata to recover the original fn information
pre-desugaring. :tag information comes from analyzing the body.

cljs.analyzer/infer-invoke has been changed to prefer inference over
:ret-tag.

In all cases we make sure enough `:methods` information is available
for infer-invoke to work.

Tweak cljs.analyzer/analyze-form-seq so that it's a bit more useful
under testing.

Add basic tests cases for the above as well as bringing back a large
number of inference tests that were commented out.

Author: swannodette

src/main/cljs/cljs/core.cljs

@@ -1817,7 +1817,7 @@ reduces them without incurring seq initialization"
       (alength coll)
 
       (string? coll)
-      (.-length coll)
+      ^number (.-length coll)
 
       (implements? ISeqable coll)
       (accumulating-seq-count coll)

src/main/clojure/cljs/analyzer.cljc

@@ -1346,16 +1346,15 @@
                              else-tag #{else-tag})]
               (into then-tag else-tag))))))))
 
-(defn infer-invoke [env e]
-  (let [{info :info :as f} (:fn e)]
-    (if-some [ret-tag (if (or (true? (:fn-var info))
-                              (true? (:js-fn-var info)))
-                        (:ret-tag info)
-                        (when (= 'js (:ns info)) 'js))]
+(defn infer-invoke [env {f :fn :keys [args] :as e}]
+  (let [me (assoc (find-matching-method f args) :op :fn-method)]
+    (if-some [ret-tag (infer-tag env me)]
       ret-tag
-      (let [args (:args e)
-            me (assoc (find-matching-method f args) :op :fn-method)]
-        (if-some [ret-tag (infer-tag env me)]
+      (let [{:keys [info]} f]
+        (if-some [ret-tag (if (or (true? (:fn-var info))
+                                  (true? (:js-fn-var info)))
+                            (:ret-tag info)
+                            (when (= 'js (:ns info)) 'js))]
           ret-tag
           ANY_SYM)))))
 
@@ -2101,6 +2100,8 @@
                      ;; TODO: can we simplify - David
                      (merge be
                        {:fn-var true
+                        ;; copy over the :fn-method information we need for invoke type inference
+                        :methods (into [] (map #(select-keys % [:tag :fixed-arity :variadic?]) (:methods init-expr)))
                         :variadic? (:variadic? init-expr)
                         :max-fixed-arity (:max-fixed-arity init-expr)
                         :method-params (map :params (:methods init-expr))})
@@ -2267,6 +2268,20 @@
                           (when (:field texpr)
                             texpr))))
               vexpr (analyze enve val)]
+          ;; as top level fns are decomposed for Closure cross-module code motion, we need to
+          ;; restore their :methods information
+          (when (seq? target)
+            (let [sym  (some-> target second)
+                  meta (meta sym)]
+              (when-let [info (and (= :fn (:op vexpr)) (:top-fn meta))]
+                (swap! env/*compiler* update-in
+                  [::namespaces (-> env :ns :name) :defs sym :methods]
+                  (fnil conj [])
+                  ;; just use original fn meta, as the fn method is already desugared
+                  ;; only get tag from analysis
+                  (merge
+                    (select-keys info [:fixed-arity :variadic?])
+                    (select-keys (-> vexpr :methods first) [:tag]))))))
           (when-not texpr
             (throw (error env "set! target must be a field or a symbol naming a var")))
           (cond
@@ -3723,12 +3738,18 @@
          :meta meta-expr :expr expr :children [:meta :expr]})
       expr)))
 
-(defn infer-type [env ast _]
-    (if (nil? (:tag ast))
+(defn infer-type [env {:keys [tag] :as ast} _]
+  (if (or (nil? tag) (= 'function tag))
+    ;; infer-type won't get a chance to process :methods
+    ;; so treat :fn as a special case for now, could probably
+    ;; fix up to use :children to walk child nodes
+    (if (= :fn (:op ast))
+      (update ast :methods
+        (fn [ms] (into [] (map #(infer-type env % _)) ms)))
       (if-some [tag (infer-tag env ast)]
-          (assoc ast :tag tag)
-          ast)
-      ast))
+        (assoc ast :tag tag)
+        ast))
+    ast))
 
 (defn- repl-self-require? [env deps]
   (and (:repl-env env) (some #{*cljs-ns*} deps)))
@@ -4305,22 +4326,26 @@
      (when env/*compiler*
        (:options @env/*compiler*))))
   ([forms opts]
+   (analyze-form-seq forms opts false))
+  ([forms opts return-last?]
    (let [env (assoc (empty-env) :build-options opts)]
      (binding [*file-defs* nil
                #?@(:clj [*unchecked-if* false
                          *unchecked-arrays* false])
                *cljs-ns* 'cljs.user
                *cljs-file* nil
                reader/*alias-map* (or reader/*alias-map* {})]
-       (loop [ns nil forms forms]
+       (loop [ns nil forms forms last-ast nil]
          (if (some? forms)
            (let [form (first forms)
                  env  (assoc env :ns (get-namespace *cljs-ns*))
                  ast  (analyze env form nil opts)]
              (if (= (:op ast) :ns)
-               (recur (:name ast) (next forms))
-               (recur ns (next forms))))
-           ns))))))
+               (recur (:name ast) (next forms) ast)
+               (recur ns (next forms) ast)))
+           (if return-last?
+             last-ast
+             ns)))))))
 
 (defn ensure-defs
   "Ensures that a non-nil defs map exists in the compiler state for a given

src/main/clojure/cljs/core.cljc

@@ -3055,7 +3055,8 @@
               `[(set! (. ~sym ~'-cljs$lang$maxFixedArity)
                   ~(core/dec (count sig)))])
           (js-inline-comment " @this {Function} ")
-          (set! (. ~sym ~'-cljs$lang$applyTo)
+          ;; dissoc :top-fn so this helper gets ignored in cljs.analyzer/parse 'set!
+          (set! (. ~(vary-meta sym dissoc :top-fn) ~'-cljs$lang$applyTo)
             ~(apply-to)))))))
 
 (core/defmacro copy-arguments [dest]
@@ -3080,23 +3081,26 @@
                sig   (remove '#{&} arglist)
                c-1   (core/dec (count sig))
                macro? (:macro meta)
+               mfa   (core/cond-> c-1 macro? (core/- 2))
                meta  (assoc meta
                        :top-fn
                        {:variadic? true
-                        :max-fixed-arity (core/cond-> c-1 macro? (core/- 2))
+                        :fixed-arity mfa
+                        :max-fixed-arity mfa
                         :method-params (core/cond-> [sig] macro? elide-implicit-macro-args)
                         :arglists (core/cond-> (core/list arglist) macro? elide-implicit-macro-args)
-                        :arglists-meta (doall (map meta [arglist]))})]
+                        :arglists-meta (doall (map meta [arglist]))})
+               name  (with-meta name meta)]
       `(do
-         (def ~(with-meta name meta)
+         (def ~name
            (fn [~'var_args]
              (let [args# (array)]
                (copy-arguments args#)
                (let [argseq# (when (< ~c-1 (alength args#))
                                (new ^::ana/no-resolve cljs.core/IndexedSeq
                                  (.slice args# ~c-1) 0 nil))]
                  (. ~rname (~'cljs$core$IFn$_invoke$arity$variadic ~@(dest-args c-1) argseq#))))))
-         ~(variadic-fn* rname method)
+         ~(variadic-fn* name method)
          ~(core/when emit-var? `(var ~name))))))
 
 (core/comment
@@ -3117,11 +3121,14 @@
                          (~(symbol
                              (core/str "cljs$core$IFn$_invoke$arity$" c))
                            ~@(dest-args c)))]))
-               (fn-method [[sig & body :as method]]
+               (fn-method [name [sig & body :as method]]
                  (if (some '#{&} sig)
                    (variadic-fn* name method false)
+                   ;; fix up individual :fn-method meta for
+                   ;; cljs.analyzer/parse 'set! :top-fn handling
                    `(set!
-                      (. ~name
+                      (. ~(vary-meta name update :top-fn merge
+                            {:variadic? false :fixed-arity (count sig)})
                         ~(symbol (core/str "-cljs$core$IFn$_invoke$arity$"
                                    (count sig))))
                       (fn ~method))))]
@@ -3135,19 +3142,22 @@
                             (map count sigs)
                             [(core/- (count (first (filter varsig? arglists))) 2)]))
                macro?   (:macro meta)
+               mfa      (core/cond-> maxfa macro? (core/- 2))
                meta     (assoc meta
                           :top-fn
                           {:variadic? variadic
-                           :max-fixed-arity (core/cond-> maxfa macro? (core/- 2))
+                           :fixed-arity mfa
+                           :max-fixed-arity mfa
                            :method-params (core/cond-> sigs macro? elide-implicit-macro-args)
                            :arglists (core/cond-> arglists macro? elide-implicit-macro-args)
                            :arglists-meta (doall (map meta arglists))})
                args-sym (gensym "args")
-               param-counts (map count arglists)]
+               param-counts (map count arglists)
+               name     (with-meta name meta)]
       (core/when (not= (distinct param-counts) param-counts)
         (ana/warning :overload-arity {} {:name name}))
       `(do
-         (def ~(with-meta name meta)
+         (def ~name
            (fn [~'var_args]
              (case (alength (js-arguments))
                ~@(mapcat #(fixed-arity rname %) sigs)
@@ -3165,7 +3175,7 @@
                              (str "Invalid arity: " (- (alength (js-arguments)) 2))))
                     `(throw (js/Error.
                              (str "Invalid arity: " (alength (js-arguments))))))))))
-         ~@(map fn-method fdecl)
+         ~@(map #(fn-method name %) fdecl)
          ;; optimization properties
          (set! (. ~name ~'-cljs$lang$maxFixedArity) ~maxfa)
          ~(core/when emit-var? `(var ~name))))))