typedclojure · alexander-yakushev · May 29, 2024 · Jul 31, 2024 · Jul 31, 2024 · Aug 9, 2024
diff --git a/typed/clj.analyzer/src/typed/clj/analyzer/passes/analyze_host_expr.cljc b/typed/clj.analyzer/src/typed/clj/analyzer/passes/analyze_host_expr.cljc
@@ -162,46 +162,56 @@
 
    A :host-interop node represents either an instance-field or a no-arg instance-method. "
   {:pass-info {:walk :post :depends #{}}}
-  [{:keys [op target form tag env class] :as ast} opts]
-  (case op
-    (:host-interop :host-call :host-field)
-    (let [target (if-let [the-class (and (= :local (:op target))
-                                         (u/maybe-class-literal (:form target)))]
-                   (merge target
-                          (assoc (ana/analyze-const the-class env :class opts)
-                            :tag   #?(:cljr Type :default Class)
-                            :o-tag #?(:cljr Type :default Class)))
-                   target)
-          class? (and (= :const (:op target))
-                      (= :class (:type target))
-                      (:form target))
-          target-type (if class? :static :instance)]
-      (merge' (dissoc ast :assignable? :target :args :children)
-              (case op
-
-                :host-call
-                (analyze-host-call target-type (:method ast)
-                                   (:args ast) target class? env)
-
-                :host-field
-                (analyze-host-field target-type (:field ast)
-                                    target (or class? (:tag target)) env)
-
-                :host-interop
-                (-analyze-host-expr target-type (:m-or-f ast)
-                                    target class? env))
-              (when tag
-                {:tag tag})))
-    :var
-    (if-let [the-class (and (not (namespace form))
-                            (pos? (#?(:cljr .IndexOf :default .indexOf) (str form) "."))
-                            (u/maybe-class-literal form))]
-      (assoc (ana/analyze-const the-class env :class opts) :form form)
-      ast)
-
-    :maybe-class
-    (if-let [the-class (u/maybe-class-literal class)]
-      (assoc (ana/analyze-const the-class env :class opts) :form form)
-      ast)
-
-    ast))
+  [ast opts]
+  (let [op (:op ast)]
+    (case op
+      (:host-interop :host-call :host-field)
+      (let [target (:target ast)
+            tag (:tag ast)
+            env (:env ast)
+            target-op (:op target)
+            target (if-let [the-class (and (= :local target-op)
+                                           (u/maybe-class-literal (:form target)))]
+                     (merge target
+                            (assoc (ana/analyze-const the-class env :class opts)
+                              :tag   #?(:cljr Type :default Class)
+                              :o-tag #?(:cljr Type :default Class)))
+                     target)
+            class? (and (= :const target-op)
+                        (= :class (:type target))
+                        (:form target))
+            target-type (if class? :static :instance)]
+        (merge' (dissoc ast :assignable? :target :args :children)
+                (case op
+
+                  :host-call
+                  (analyze-host-call target-type (:method ast)
+                                     (:args ast) target class? env)
+
+                  :host-field
+                  (analyze-host-field target-type (:field ast)
+                                      target (or class? (:tag target)) env)
+
+                  :host-interop
+                  (-analyze-host-expr target-type (:m-or-f ast)
+                                      target class? env))
+                (when tag
+                  {:tag tag})))
+      :var
+      (let [form (:form ast)
+            env (:env ast)]
+        (if-let [the-class (and (not (namespace form))
+                                (pos? (#?(:cljr .IndexOf :default .indexOf) (str form) "."))
+                                (u/maybe-class-literal form))]
+          (assoc (ana/analyze-const the-class env :class opts) :form form)
+          ast))
+
+      :maybe-class
+      (let [form (:form ast)
+            env (:env ast)
+            class (:class ast)]
+       (if-let [the-class (u/maybe-class-literal class)]
+         (assoc (ana/analyze-const the-class env :class opts) :form form)
+         ast))
+
+      ast)))
diff --git a/typed/clj.analyzer/src/typed/clj/analyzer/passes/annotate_host_info.cljc b/typed/clj.analyzer/src/typed/clj/analyzer/passes/annotate_host_info.cljc
@@ -31,10 +31,14 @@
    the reflected informations for the required methods, replaces
    (catch :default ..) forms with (catch Throwable ..)"
   {:pass-info {:walk :pre :depends #{} :after #{#'elide-meta/elide-meta}}}
-  [{:keys [op methods interfaces class env] :as ast} opts]
-  (case op
+  [ast opts]
+  (case (:op ast)
     (:reify :deftype)
-    (let [all-methods
+    (let [methods (:methods ast)
+          interfaces (:interfaces ast)
+          class (:class ast)
+          env (:env ast)
+          all-methods
           (into #{}
                 (mapcat (fn [class]
                           (mapv (fn [method]
@@ -58,7 +62,9 @@
 
 
     :catch
-    (let [the-class (cond
+    (let [class (:class ast)
+          env (:env ast)
+          the-class (cond
 
                      (and (= :const (:op class))
                           (= :default (:form class)))
@@ -80,7 +86,14 @@
     :method
     ;; this should actually be in validate but it's here since it needs to be prewalked
     ;; for infer-tag purposes
-    (let [{:keys [name class tag form params fixed-arity env]} ast]
+    (let [methods (:methods ast)
+          interfaces (:interfaces ast)
+          class (:class ast)
+          env (:env ast)
+          name (:name ast)
+          tag (:tag ast)
+          form (:form ast)
+          params (:params ast)]
       (if interfaces
         (let [tags (mapv (comp ju/maybe-class :tag meta :form) params)
               methods-set (into #{} (map (fn [x] (dissoc x :declaring-class :flags))) methods)]

diff --git a/typed/clj.analyzer/src/typed/clj/analyzer/passes/annotate_tag.cljc b/typed/clj.analyzer/src/typed/clj/analyzer/passes/annotate_tag.cljc
@@ -74,18 +74,23 @@
   "If the AST node type is a constant object or contains :tag metadata,
    attach the appropriate :tag and :o-tag to the node."
   {:pass-info {:walk :post :depends #{} :after #{#'constant-lift/constant-lift}}}
-  [{:keys [op atom tag o-tag] :as ast} opts]
-  (let [ast (cond-> ast
+  [ast opts]
+  (let [op (:op ast)
+        atom (:atom ast)
+        tag (:tag ast)
+        o-tag (:o-tag ast)
+
+        ast (cond-> ast
               (and atom (:case-test @atom))
               (update :form vary-meta dissoc :tag))
 
-        ast (cond-> ast
-              (not (and o-tag tag))
-              (-> -annotate-tag
-                  (into (when-let [tag (or tag
-                                           (-> ast :val meta :tag)
-                                           (-> ast :form meta :tag))]
-                          {:tag tag}))))]
+        ast (if (and o-tag tag)
+              ast
+              (let [tag (or tag
+                            (-> ast :val meta :tag)
+                            (-> ast :form meta :tag))]
+                (cond-> (-annotate-tag ast)
+                  tag (assoc :tag tag))))]
     (when (= op :binding)
       (assert atom)
       (swap! atom assoc :tag (:tag ast)))

diff --git a/typed/clj.analyzer/src/typed/clj/analyzer/passes/validate.cljc b/typed/clj.analyzer/src/typed/clj/analyzer/passes/validate.cljc
@@ -73,8 +73,8 @@
             c-name #?(:cljr '.ctor :default (symbol (.getName class)))  ;;                                                                  ;; in .NET, ctors are named .ctor, not with the class name
             argc (count args)
             tags (mapv :tag args)]
-        (let [[ctor & rest] (->> (filter #(= (count (:parameter-types %)) argc)
-                                         (ju/members class c-name))
+        (let [[ctor & rest] (->> (eduction (filter #(= (count (:parameter-types %)) argc))
+                                           (ju/members class c-name))
                                  (ju/try-best-match tags))]
           (if ctor
             (if (empty? rest)
@@ -92,10 +92,10 @@
 (defn validate-call [{:keys [class instance method args tag env op] :as ast}]
   (let [argc (count args)
         instance? (= :instance-call op)
-        f (if instance? ju/instance-methods ju/static-methods)]
-    (if-let [matching-methods (not-empty (f class method argc))]
-      (let [tags (mapv :tag args)
-            [m & rest :as matching] (ju/try-best-match tags matching-methods)]
+        f (if instance? ju/instance-methods ju/static-methods)
+        tags (mapv :tag args)]
+    (if-let [matching-methods (not-empty (into [] (f class method argc)))]
+      (let [[m & rest :as matching] (ju/try-best-match tags matching-methods)]
         (if m
           (let [all-ret-equals? (apply = (map :return-type matching))]
             (if (or (empty? rest)

diff --git a/typed/clj.analyzer/src/typed/clj/analyzer/utils.cljc b/typed/clj.analyzer/src/typed/clj/analyzer/utils.cljc
@@ -435,14 +435,14 @@
   (eduction (remove (comp :static :flags)) (members2 class f)))
 
 (defn static-methods [class method argc]
-  (into [] (filter #(and (instance? clojure.reflect.Method %)
-                         (= argc (count (:parameter-types %)))))
-        (static-members class method)))
+  (eduction (filter #(and (instance? clojure.reflect.Method %)
+                          (= argc (count (:parameter-types %)))))
+            (static-members class method)))
 
 (defn instance-methods [class method argc]
-  (into [] (filter #(and (instance? clojure.reflect.Method %)
-                         (= argc (count (:parameter-types %)))))
-        (instance-members class method)))
+  (eduction (filter #(and (instance? clojure.reflect.Method %)
+                          (= argc (count (:parameter-types %)))))
+            (instance-members class method)))
 
 (defn- field [member]
   (when (instance? clojure.reflect.Field member)
@@ -500,8 +500,8 @@
    subset of methods that match best the given tags"
   [tags methods]
   (let [o-tags (mapv #(or (maybe-class %) Object) tags)]
-    (if-let [methods (or (seq (filterv #(= o-tags (mapv maybe-class (:parameter-types %))) methods))
-                         (seq (filterv #(tag-match? tags %) methods)))]
+    (if-let [methods (or (not-empty (filterv #(= o-tags (mapv maybe-class (:parameter-types %))) methods))
+                         (not-empty (filterv #(tag-match? tags %) methods)))]
       (reduce (fn [[prev & _ :as p] next]
                 (let [prev-params (mapv maybe-class (:parameter-types prev))
                       next-params (mapv maybe-class (:parameter-types next))

diff --git a/typed/clj.runtime/src/typed/cljc/runtime/perf_utils.clj b/typed/clj.runtime/src/typed/cljc/runtime/perf_utils.clj
@@ -4,7 +4,7 @@
 (defn some
   "Like `clojure.core/some`, but uses an iterator over `lst`."
   [f ^Iterable lst]
-  (let [it (.iterator lst)]
+  (when-let [it (some-> lst .iterator)]
     (loop []
       (when (.hasNext it)
         (or (f (.next it))
@@ -13,13 +13,15 @@
 (defn every?
   "Like `clojure.core/every?`, but uses an iterator over `lst`."
   [f ^Iterable lst]
-  (let [it (.iterator lst)]
-    (loop []
-      (if (.hasNext it)
-        (if (f (.next it))
-          (recur)
-          false)
-        true))))
+  (if (nil? lst)
+    true
+    (let [it (.iterator lst)]
+      (loop []
+        (if (.hasNext it)
+          (if (f (.next it))
+            (recur)
+            false)
+          true)))))
 
 (defn repeatedly
   "Like `clojure.core/repeatedly`, but eager and more efficient."

diff --git a/typed/cljc.analyzer/src/typed/cljc/analyzer.cljc b/typed/cljc.analyzer/src/typed/cljc/analyzer.cljc
@@ -256,9 +256,9 @@
 (defn propagate-top-level
   "Propagate :top-level down :do nodes. Attach ::ana2/eval-gilardi? to
   root nodes that should be evaluated."
-  [{:keys [op] :as ast}]
-  (if (and (not= :unanalyzed op)
-           (get-in ast [::config :top-level]))
+  [ast]
+  (if (and (not= :unanalyzed (:op ast))
+           (:top-level (::config ast)))
     ; we know this root node is fully analyzed, so we can reliably predict
     ; whether to evaluate it under the Gilardi scenario.
     (case (:op ast)

diff --git a/typed/cljc.analyzer/src/typed/cljc/analyzer/ast.cljc b/typed/cljc.analyzer/src/typed/cljc/analyzer/ast.cljc
@@ -27,6 +27,7 @@
   (when children
     (mapv #(find ast %) children)))
 
+;; note: typed.cljc.analyzer.passes.uniquify has an optimization based on this impl
 (defn children
   "Return a vector of the children expression of the AST node, if it has any.
    The children expressions are kept in order and flattened so that the returning

diff --git a/typed/cljc.analyzer/src/typed/cljc/analyzer/passes/elide_meta.clj b/typed/cljc.analyzer/src/typed/cljc/analyzer/passes/elide_meta.clj
@@ -86,6 +86,8 @@
    dissoc all the keys in elides from the metadata."
   {:pass-info {:walk :any :depends #{} :after #{#'source-info}}}
   [ast opts]
-  (if (some #(if (seq? %) (seq %) %) (vals elides))
+  ;; Nothing in the code rebinds the `elides` dynvar, so it is enough to check
+  ;; for the global *compiler-options* here.
+  (if (:elide-meta *compiler-options*)
     (-elide-meta ast)
     ast))
diff --git a/typed/cljc.analyzer/src/typed/cljc/analyzer/passes/source_info.clj b/typed/cljc.analyzer/src/typed/cljc/analyzer/passes/source_info.clj
@@ -10,13 +10,10 @@
 (ns typed.cljc.analyzer.passes.source-info
   (:require [typed.cljc.analyzer.utils :refer [-source-info merge']]))
 
-(defn -merge-source-info [source-info]
-  (fn [ast]
-    (update ast :env merge' source-info)))
-
 (defn source-info
   "Adds (when available) :line, :column, :end-line, :end-column and :file info to the AST :env"
   {:pass-info {:walk :pre :depends #{}}}
   [ast opts]
-  (let [source-info (-source-info (:form ast) (:env ast))]
-    (update ast :env merge' source-info)))
+  (let [env (:env ast)
+        env-with-source-info (-source-info (:form ast) env env)]
+    (assoc ast :env env-with-source-info)))