Merge branch 'wip-method-values'

Author: bronsa

CHANGELOG.md

@@ -2,6 +2,10 @@ Changelog
 ========================================
 Since tools.analyzer.jvm version are usually cut simultaneously with a tools.analyzer version, check also the tools.analyzer [CHANGELOG](https://github.com/clojure/tools.analyzer/blob/master/CHANGELOG.md) for changes on the corresponding version, since changes in that library will reflect on this one.
 - - -
+* Release 1.4.0 on TODO
+  * Added support for Clojure 1.12 qualified methods (Class/.method, Class/method, Class/new)
+  * Added :method-value AST node for method values in value position
+  * Added :param-tags support for overload disambiguation in method values and host calls
 * Release 1.3.3 on 5 Jan 2026
   * Bumped parent pom and dep versions
 * Release 1.3.2 on 17 Jan 2025

build.clj

@@ -0,0 +1,11 @@
+(ns build
+  (:require
+   [clojure.tools.build.api :as b]))
+
+(def basis
+  (b/create-basis {:project "deps.edn"}))
+
+(defn compile-test-java [_]
+  (b/javac {:src-dirs ["src/test/java"]
+            :class-dir "target/test-classes"
+            :basis basis}))

deps.edn

@@ -1,6 +1,8 @@
 {:deps {org.clojure/clojure {:mvn/version "1.12.4"}
-        org.clojure/tools.analyzer {:mvn/version "1.2.1"}
+        org.clojure/tools.analyzer {:mvn/version "1.2.2"}
         org.clojure/tools.reader {:mvn/version "1.6.0"}
         org.clojure/core.memoize {:mvn/version "1.2.273"}
         org.ow2.asm/asm {:mvn/version  "9.9.1"}}
- :paths ["src/main/clojure"]}
+ :paths ["src/main/clojure" "src/test/clojure" "target/test-classes"]
+ :aliases {:build {:deps {io.github.clojure/tools.build {:mvn/version "0.10.6"}}
+                   :ns-default build}}}

pom.xml

@@ -27,7 +27,7 @@
     <dependency>
       <groupId>org.clojure</groupId>
       <artifactId>tools.analyzer</artifactId>
-      <version>1.2.1</version>
+      <version>1.2.2</version>
     </dependency>
     <dependency>
       <groupId>org.clojure</groupId>
@@ -46,6 +46,10 @@
     </dependency>
   </dependencies>
 
+  <build>
+    <testSourceDirectory>src/test/java</testSourceDirectory>
+  </build>
+
   <scm>
     <connection>scm:git:git://github.com/clojure/tools.analyzer.jvm.git</connection>
     <developerConnection>scm:git:git://github.com/clojure/tools.analyzer.jvm.git</developerConnection>

spec/ast-ref.edn

@@ -176,7 +176,9 @@
           ^:optional
           [:validated? "`true` if the method call could be resolved at compile time"]
           ^:optional
-          [:class "If :validated? the class or interface the method belongs to"]]}
+          [:class "If :validated? the class or interface the method belongs to"]
+          ^:optional
+          [:param-tags "A vector of type hints for overload disambiguation, from `^[Type ...]` metadata on the invocation form"]]}
   {:op   :instance-field
    :doc  "Node for an instance field access"
    :keys  [[:form "`(.-field instance)`"]
@@ -266,6 +268,19 @@
           [:fixed-arity "The number of args this method takes"]
           ^:children
           [:body "Synthetic :do node (with :body? `true`) representing the body of this method"]]}
+  {:op   :method-value
+   :doc  "Node for a qualified method reference in value position (Clojure 1.12+)"
+   :keys [[:form "The original qualified method symbol, e.g. `String/valueOf`, `File/.getName`, `File/new`"]
+          [:class "The resolved Class the method belongs to"]
+          [:method "Symbol naming the method"]
+          [:kind "One of :static, :instance, or :ctor"]
+          ^:optional
+          [:param-tags "A vector of type hints for overload disambiguation, from `^[Type ...]` metadata"]
+          [:methods "A vector of matching method/constructor reflective info maps"]
+          ^:optional
+          [:field-overload "When :kind is :static and a static field of the same name exists, the field info map"]
+          ^:optional
+          [:validated? "`true` if the method value could be resolved at compile time"]]}
   {:op   :monitor-enter
    :doc  "Node for a monitor-enter special-form statement"
    :keys [[:form "`(monitor-enter target)`"]
@@ -349,7 +364,9 @@
           ^:children
           [:args "A vector of AST nodes representing the args to the method call"]
           ^:optional
-          [:validated? "`true` if the static method could be resolved at compile time"]]}
+          [:validated? "`true` if the static method could be resolved at compile time"]
+          ^:optional
+          [:param-tags "A vector of type hints for overload disambiguation, from `^[Type ...]` metadata on the invocation form"]]}
   {:op   :static-field
    :doc  "Node for a static field access"
    :keys [[:form "`Class/field`"]

src/main/clojure/clojure/tools/analyzer/jvm.clj

@@ -34,6 +34,7 @@
              [box :refer [box]]
              [constant-lifter :refer [constant-lift]]
              [classify-invoke :refer [classify-invoke]]
+             [process-method-value :refer [process-method-value]]
              [validate :refer [validate]]
              [infer-tag :refer [infer-tag]]
              [validate-loop-locals :refer [validate-loop-locals]]
@@ -90,8 +91,7 @@
     #'clojure.core/when-not
     #'clojure.core/while
     #'clojure.core/with-open
-    #'clojure.core/with-out-str
-    })
+    #'clojure.core/with-out-str})
 
 (def specials
   "Set of the special forms for clojure in the JVM"
@@ -127,13 +127,31 @@
   (let [sym-ns (namespace form)]
     (if-let [target (and sym-ns
                          (not (resolve-ns (symbol sym-ns) env))
-                         (maybe-class-literal sym-ns))]          ;; Class/field
-      (let [opname (name form)]
-        (if (and (= (count opname) 1)
-                 (Character/isDigit (char (first opname))))
-          form ;; Array/<n>
-          (with-meta (list '. target (symbol (str "-" opname))) ;; transform to (. Class -field)
-            (meta form))))
+                         (maybe-class-literal sym-ns))]
+      (let [opname (name form)
+            opsym (symbol opname)]
+        (cond
+          ;; Array/<n>, leave as is
+          (and (= (count opname) 1)
+               (Character/isDigit (char (first opname))))
+          form
+
+          ;; Class/.method or Class/new, leave as is to be parsed as :maybe-host-form -> :method-value
+          (or (.startsWith ^String opname ".")
+              (= "new" opname))
+          form
+
+          ;; Class/name where name is a static field,  desugar to (. Class -name) as before
+          ;; But if :param-tags are present and methods with the same name exist, then leave as is to go through
+          ;; :method-value path
+          (static-field target opsym)
+          (if (and (param-tags-of form)
+                   (seq (filter :return-type (static-members target opsym))))
+            form
+            (with-meta (list '. target (symbol (str "-" opname)))
+              (meta form)))
+
+          :else form))
       form)))
 
 (defn desugar-host-expr [form env]
@@ -143,13 +161,23 @@
             opns   (namespace op)]
         (if-let [target (and opns
                              (not (resolve-ns (symbol opns) env))
-                             (maybe-class-literal opns))] ; (class/field ..)
+                             (maybe-class-literal opns))]
 
-          (let [op (symbol opname)]
-            (with-meta (list '. target (if (zero? (count expr))
-                                         op
-                                         (list* op expr)))
-              (meta form)))
+          (cond
+           ;; (Class/new args), (Class/.method target args), (^[pt] Class/method args)
+           ;; -> leave as-is, will be analyzed as invoke of method-value
+           (or (= "new" opname)
+               (.startsWith ^String opname ".")
+               (param-tags-of op))
+           form
+
+           ;; (Class/method args) -> (. Class (method args))
+           :else
+           (let [op-sym (symbol opname)]
+             (with-meta (list '. target (if (seq expr)
+                                          (list* op-sym expr)
+                                          op-sym))
+               (meta form))))
 
           (cond
            (.startsWith opname ".")     ; (.foo bar ..)
@@ -456,6 +484,7 @@
     #'box
 
     #'analyze-host-expr
+    #'process-method-value
     #'validate-loop-locals
     #'validate
     #'infer-tag

src/main/clojure/clojure/tools/analyzer/jvm/utils.clj

@@ -390,6 +390,44 @@
                    (conj p next)))) [] methods)
       methods)))
 
+(defn param-tags-of [sym]
+  (-> sym meta :param-tags))
+
+(defn- tags-to-maybe-classes
+  [tags]
+  (mapv (fn [tag]
+          (when-not (= '_ tag)
+            (maybe-class tag)))
+        tags))
+
+(defn- signature-matches?
+  [param-classes method]
+  (let [method-params (:parameter-types method)]
+    (and (= (count param-classes) (count method-params))
+         (every? (fn [[pc mp]]
+                   (or (nil? pc) ;; nil is a wildcard
+                       (= pc (maybe-class mp))))
+                 (map vector param-classes method-params)))))
+
+(defn- most-specific
+  [methods]
+  (map (fn [ms]
+         (reduce (fn [a b]
+                   (if (.isAssignableFrom (maybe-class (:declaring-class a))
+                                          (maybe-class (:declaring-class b)))
+                     b a))
+                 ms))
+       (vals (group-by #(mapv maybe-class (:parameter-types %)) methods))))
+
+(defn resolve-hinted-method
+  "Given a class, method name and param-tags, resolves to the unique matching method.
+   Returns nil if no match or if ambiguous."
+  [methods param-tags]
+  (let [param-classes (tags-to-maybe-classes param-tags)
+        matching (most-specific (filter #(signature-matches? param-classes %) methods))]
+    (when (= 1 (count matching))
+      (first matching))))
+
 (defn ns->relpath [s]
   (-> s str (s/replace \. \/) (s/replace \- \_) (str ".clj")))
 

src/main/clojure/clojure/tools/analyzer/passes/jvm/analyze_host_expr.clj

@@ -9,7 +9,8 @@
 (ns clojure.tools.analyzer.passes.jvm.analyze-host-expr
   (:require [clojure.tools.analyzer :as ana]
             [clojure.tools.analyzer.utils :refer [ctx source-info merge']]
-            [clojure.tools.analyzer.jvm.utils :refer :all]))
+            [clojure.tools.analyzer.jvm.utils :refer :all])
+  (:import (clojure.lang AFunction)))
 
 (defn maybe-static-field [[_ class sym]]
   (when-let [{:keys [flags type name]} (static-field class sym)]
@@ -142,8 +143,9 @@
 (defn analyze-host-expr
   "Performing some reflection, transforms :host-interop/:host-call/:host-field
    nodes in either: :static-field, :static-call, :instance-call, :instance-field
-   or :host-interop nodes, and a :var/:maybe-class/:maybe-host-form node in a
-   :const :class node, if necessary (class literals shadow Vars).
+   or :host-interop nodes, a :var/:maybe-class/:maybe-host-form node in a
+   :const :class node if necessary (class literals shadow Vars), and a
+   :maybe-host-form node in a :method-value node for qualified methods.
 
    A :host-interop node represents either an instance-field or a no-arg instance-method. "
   {:pass-info {:walk :post :depends #{}}}
@@ -190,9 +192,47 @@
       ast)
 
     :maybe-host-form
-    (if-let [the-class (maybe-array-class-sym (symbol (str (:class ast))
-                                                      (str (:field ast))))]
-      (assoc (ana/analyze-const the-class env :class) :form form)
-      ast)
-
+    (let [class-sym  (:class ast)
+          field-sym  (:field ast)
+          field-name (name field-sym)]
+      (if-let [array-class (maybe-array-class-sym (symbol (str class-sym) field-name))]
+        (assoc (ana/analyze-const array-class env :class) :form form)
+        (if-let [the-class (maybe-class-literal class-sym)]
+          (let [param-tags   (param-tags-of form)
+                kind         (cond (.startsWith field-name ".") :instance
+                                   (= "new" field-name)         :ctor
+                                   :else                        :static)
+                method-name  (if (= :instance kind)
+                               (symbol (subs field-name 1))
+                               field-sym)
+                methods      (case kind
+                               :ctor
+                               (members the-class (symbol (.getName ^Class the-class)))
+
+                               :static
+                               (filter :return-type (static-members the-class method-name))
+
+                               :instance
+                               (filter :return-type (instance-members the-class method-name)))
+                field-info   (when (= :static kind)
+                               (static-field the-class method-name))]
+            ;; field info but no methods shouldn't be possible, as we'd have desugared
+            ;; to a field syntax directly
+            (assert (if field-info methods true))
+            (if (seq methods)
+              (merge
+               {:op         :method-value
+                :form       form
+                :env        env
+                :class      the-class
+                :method     method-name
+                :kind       kind
+                :param-tags param-tags
+                :methods    (vec methods)
+                :o-tag      AFunction
+                :tag        (or tag AFunction)}
+               (when field-info
+                 {:field-overload field-info}))
+              ast))
+          ast)))
     ast))

src/main/clojure/clojure/tools/analyzer/passes/jvm/emit_form.clj

@@ -113,23 +113,38 @@
                           tests thens))
           ~switch-type ~test-type ~skip-check?))
 
+(defmethod -emit-form :new
+  [{:keys [class args param-tags]} opts]
+  (if param-tags
+    (let [sym (symbol (class->str (:val class)) "new")
+          sym (vary-meta sym assoc :param-tags param-tags)]
+      `(~sym ~@(mapv #(-emit-form* % opts) args)))
+    `(new ~(-emit-form* class opts) ~@(mapv #(-emit-form* % opts) args))))
+
 (defmethod -emit-form :static-field
-  [{:keys [class field]} opts]
-  (symbol (class->str class) (name field)))
+  [{:keys [class field overloaded-field?]} opts]
+  (if overloaded-field?
+    `(. ~(class->sym class) ~(symbol (str "-" (name field))))
+    (list (symbol (class->str class) (name field)))))
 
 (defmethod -emit-form :static-call
-  [{:keys [class method args]} opts]
-  `(~(symbol (class->str class) (name method))
-    ~@(mapv #(-emit-form* % opts) args)))
+  [{:keys [class method args param-tags]} opts]
+  (let [sym (symbol (class->str class) (name method))
+        sym (if param-tags (vary-meta sym assoc :param-tags param-tags) sym)]
+    `(~sym ~@(mapv #(-emit-form* % opts) args))))
 
 (defmethod -emit-form :instance-field
   [{:keys [instance field]} opts]
   `(~(symbol (str ".-" (name field))) ~(-emit-form* instance opts)))
 
 (defmethod -emit-form :instance-call
-  [{:keys [instance method args]} opts]
-  `(~(symbol (str "." (name method))) ~(-emit-form* instance opts)
-    ~@(mapv #(-emit-form* % opts) args)))
+  [{:keys [instance method args class param-tags]} opts]
+  (if param-tags
+    (let [sym (symbol (class->str class) (str "." (name method)))
+          sym (vary-meta sym assoc :param-tags param-tags)]
+      `(~sym ~(-emit-form* instance opts) ~@(mapv #(-emit-form* % opts) args)))
+    `(~(symbol (str "." (name method))) ~(-emit-form* instance opts)
+      ~@(mapv #(-emit-form* % opts) args))))
 
 (defmethod -emit-form :prim-invoke
   [{:keys [fn args]} opts]
@@ -147,6 +162,17 @@
   (list (-emit-form* keyword opts)
         (-emit-form* target opts)))
 
+(defmethod -emit-form :method-value
+  [{:keys [class method kind param-tags]} opts]
+  (let [class-name (if (symbol? class) (name class) (.getName ^Class class))
+        sym (case kind
+              :static   (symbol class-name (str method))
+              :instance (symbol class-name (str "." method))
+              :ctor     (symbol class-name "new"))]
+    (if param-tags
+      (vary-meta sym assoc :param-tags param-tags)
+      sym)))
+
 (defmethod -emit-form :instance?
   [{:keys [class target]} opts]
   `(instance? ~class ~(-emit-form* target opts)))

src/main/clojure/clojure/tools/analyzer/passes/jvm/infer_tag.clj

@@ -16,7 +16,8 @@
              [annotate-tag :refer [annotate-tag]]
              [annotate-host-info :refer [annotate-host-info]]
              [analyze-host-expr :refer [analyze-host-expr]]
-             [fix-case-test :refer [fix-case-test]]]))
+             [fix-case-test :refer [fix-case-test]]
+             [process-method-value :refer [process-method-value]]]))
 
 (defmulti -infer-tag :op)
 (defmethod -infer-tag :default [ast] ast)
@@ -269,7 +270,7 @@
   Passes opts:
   * :infer-tag/level  If :global, infer-tag will perform Var tag
                       inference"
-  {:pass-info {:walk :post :depends #{#'annotate-tag #'annotate-host-info #'fix-case-test #'analyze-host-expr} :after #{#'trim}}}
+  {:pass-info {:walk :post :depends #{#'annotate-tag #'annotate-host-info #'fix-case-test #'analyze-host-expr #'process-method-value} :after #{#'trim}}}
   [{:keys [tag form] :as ast}]
   (let [tag (or tag (:tag (meta form)))
         ast (-infer-tag ast)]