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
index 600d3b7fb..9d8e65d16 100644
--- 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
index 3c574a05c..124c5fc79 100644
--- 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
index a25c8775b..4cf452a80 100644
--- 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
index c9ee27021..6f791b567 100644
--- 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
index 37bfc3d40..75c5f1685 100644
--- 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
index 81beb7831..2d741d280 100644
--- 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
index bfc036e70..3d68eb5a1 100644
--- 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
index 3253a5d40..a61be0f8b 100644
--- 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
index b06719264..d9db58f5a 100644
--- 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
index 2486e9e9d..9affd1c45 100644
--- 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)))
diff --git a/typed/cljc.analyzer/src/typed/cljc/analyzer/passes/uniquify.clj b/typed/cljc.analyzer/src/typed/cljc/analyzer/passes/uniquify.clj
index 7525c2ca7..b601b701c 100644
--- a/typed/cljc.analyzer/src/typed/cljc/analyzer/passes/uniquify.clj
+++ b/typed/cljc.analyzer/src/typed/cljc/analyzer/passes/uniquify.clj
@@ -68,13 +68,16 @@
(defmulti -uniquify-locals :op)
(defn pre-uniquify-child
- [child-ast {::keys [locals-frame locals-frame-val locals-counter] :as _env}]
- (-> child-ast
- (update :env assoc
- ::locals-frame locals-frame
- ;; immutable copy for type resolution later
- ::locals-frame-val @locals-frame
- ::locals-counter locals-counter)))
+ [child-ast env]
+ (let [locals-counter (::locals-counter env)
+ locals-frame (::locals-frame env)
+ locals-frame-val (::locals-frame-val env)]
+ (assoc child-ast :env
+ (-> (:env child-ast)
+ (assoc ::locals-frame locals-frame)
+ ;; immutable copy for type resolution later
+ (assoc ::locals-frame-val @locals-frame)
+ (assoc ::locals-counter locals-counter)))))
(defn uniquify-locals-around
[{:keys [env] :as ast} opts]
@@ -126,12 +129,34 @@
(-> ast
(update :name uniquify! env))))
+(defn- is-binding? [node]
+ (= (:op node) :binding))
+
+(defn -some
+ "Like `clojure.core/some`, but uses an iterator over `lst`."
+ [f ^Iterable lst]
+ (when-let [it (some-> lst .iterator)]
+ (loop []
+ (when (.hasNext it)
+ (or (f (.next it))
+ (recur))))))
+
+(defn- some-child-is-binding? [ast]
+ ;; More efficient version of:
+ ;; (some #(= :binding (:op %)) (children ast))
+ (-some (fn [x]
+ (let [child (get ast x)]
+ (if (vector? child)
+ (-some is-binding? child)
+ (is-binding? child))))
+ (:children ast)))
+
(defmethod -uniquify-locals :default
[{:keys [env] :as ast}]
(-> ast
(cond->
;; if some expr that introduces new bindings
- (some #(= :binding (:op %)) (children ast))
+ (some-child-is-binding? ast)
;; then set up frame so locals won't leak
(update :env push-new-locals-frame))
uniquify-locals*))
@@ -146,14 +171,16 @@
Passes opts:
* :uniquify/uniquify-env If true, uniquifies the :env :locals map"
{:pass-info {:walk :pre :depends #{}}}
- [{{::keys [locals-counter locals-frame locals-frame-val]} :env
- :as ast}
- opts]
- (-> ast
- ;; initialize top of AST tree
- (cond->
- (not locals-counter) (assoc-in [:env ::locals-counter] (atom {}))
- (not locals-frame) (assoc-in [:env ::locals-frame] (atom {}))
- ;; immutable copy for type resolution later
- (not locals-frame-val) (assoc-in [:env ::locals-frame-val] {}))
- (uniquify-locals-around opts)))
+ [ast opts]
+ (let [env (:env ast)
+ locals-counter (::locals-counter env)
+ locals-frame (::locals-frame env)
+ locals-frame-val (::locals-frame-val env)]
+ (-> ast
+ ;; initialize top of AST tree
+ (cond->
+ (not locals-counter) (assoc-in [:env ::locals-counter] (atom {}))
+ (not locals-frame) (assoc-in [:env ::locals-frame] (atom {}))
+ ;; immutable copy for type resolution later
+ (not locals-frame-val) (assoc-in [:env ::locals-frame-val] {}))
+ (uniquify-locals-around opts))))
pFad - Phonifier reborn
Pfad - The Proxy pFad of © 2024 Garber Painting. All rights reserved.
Note: This service is not intended for secure transactions such as banking, social media, email, or purchasing. Use at your own risk. We assume no liability whatsoever for broken pages.
Alternative Proxies:
Alternative Proxy
pFad Proxy
pFad v3 Proxy
pFad v4 Proxy