Merge branch 'nicola/array_class_syntax'

Author: bronsa

deps.edn

@@ -0,0 +1,6 @@
+{:deps {org.clojure/clojure {:mvn/version "1.12.0"}
+        org.clojure/tools.analyzer {:mvn/version "1.2.0"}
+        org.clojure/tools.reader {:mvn/version "1.5.0"}
+        org.clojure/core.memoize {:mvn/version "1.1.266"}
+        org.ow2.asm/asm {:mvn/version  "9.2"}}
+ :paths ["src/main/clojure"]}

pom.xml

@@ -42,7 +42,7 @@
     <dependency>
       <groupId>org.clojure</groupId>
       <artifactId>tools.reader</artifactId>
-      <version>1.4.0</version>
+      <version>1.5.0</version>
     </dependency>
   </dependencies>
 

project.clj

@@ -7,7 +7,7 @@
   :test-paths ["src/test/clojure"]
   :dependencies [[org.clojure/clojure "1.9.0"]
                  [org.clojure/core.memoize "1.1.266"]
-                 [org.clojure/tools.reader "1.4.0"]
+                 [org.clojure/tools.reader "1.5.0"]
                  [org.clojure/tools.analyzer "1.2.0"]
                  [org.ow2.asm/asm "9.2"]]
   :repositories [["sonatype" "https://oss.sonatype.org/content/repositories/releases"]

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

@@ -126,8 +126,12 @@
     (if-let [target (and sym-ns
                          (not (resolve-ns (symbol sym-ns) env))
                          (maybe-class-literal sym-ns))]          ;; Class/field
-      (with-meta (list '. target (symbol (str "-" (name form)))) ;; transform to (. Class -field)
-        (meta form))
+      (let [opname (name form)]
+        (if (and (= (count opname) 1)
+                 (Character/isDigit (first opname)))
+          form ;; Array/<n>
+          (with-meta (list '. target (symbol (str "-" opname))) ;; transform to (. Class -field)
+            (meta form))))
       form)))
 
 (defn desugar-host-expr [form env]

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

@@ -67,13 +67,16 @@
   "Takes a Symbol, String or Class and tires to resolve to a matching Class"
   class)
 
-(defn array-class [element-type]
-  (RT/classForName
-   (str "[" (-> element-type
-              maybe-class
-              Type/getType
-              .getDescriptor
-              (.replace \/ \.)))))
+(defn array-class
+  ([element-type] (array-class 1 element-type))
+  ([n element-type]
+   (RT/classForName
+    (str (apply str (repeat n"["))
+         (-> element-type
+             maybe-class
+             Type/getType
+             .getDescriptor
+             (.replace \/ \.))))))
 
 (defn maybe-class-from-string [^String s]
   (or (when-let [maybe-class (and (neg? (.indexOf s "."))
@@ -90,24 +93,36 @@
 (defmethod maybe-class String [s]
   (maybe-class (symbol s)))
 
+(defn maybe-array-class-sym [x]
+  (let [sname (name x)]
+    (if-let [c (and (= (count sname) 1)
+                    (Character/isDigit (first sname))
+                    (namespace x))]
+      (when-let [c (or (specials c)
+                       (maybe-class-from-string c))]
+        (array-class (Integer/parseInt sname) c)))))
+
 (defmethod maybe-class Symbol [sym]
-  (when-not (namespace sym)
-    (let [sname (name sym)
-          snamec (count sname)]
-      (if-let [base-type (and (.endsWith sname "<>")
-                              (maybe-class (subs sname 0 (- snamec 2))))]
-        (array-class base-type)
-        (if-let [ret (or (specials sname)
-                         (special-arrays sname))]
-          ret
-          (maybe-class-from-string sname))))))
+  (let [sname (name sym)
+        snamec (count sname)]
+    (or (maybe-array-class-sym sym)
+        (when-not (namespace sym)
+          (if-let [base-type (and (.endsWith sname "<>")
+                                  (maybe-class (subs sname 0 (- snamec 2))))]
+            ;; TODO: we're leaking into the syntax
+            (array-class base-type)
+            (if-let [ret (or (specials sname)
+                             (special-arrays sname))]
+              ret
+              (maybe-class-from-string sname)))))))
 
 (defn maybe-class-literal [x]
   (cond
-   (class? x) x
-   (symbol? x) (and (not (namespace x))
-                    (maybe-class-from-string (name x)))
-   (string? x) (maybe-class-from-string x)))
+    (class? x) x
+    (symbol? x) (or (maybe-array-class-sym x)
+                    (and (not (namespace x))
+                         (maybe-class-from-string (name x))))
+    (string? x) (maybe-class-from-string x)))
 
 (def primitive?
   "Returns non-nil if the argument represents a primitive Class other than Void"

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

@@ -142,8 +142,8 @@
 (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 or :maybe-class node in a :const :class node,
-   if necessary (class literals shadow Vars).
+   or :host-interop nodes, and a :var/:maybe-class/:maybe-host-form node in a
+   :const :class node, if necessary (class literals shadow Vars).
 
    A :host-interop node represents either an instance-field or a no-arg instance-method. "
   {:pass-info {:walk :post :depends #{}}}
@@ -189,4 +189,10 @@
       (assoc (ana/analyze-const the-class env :class) :form form)
       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)
+
     ast))

src/test/clojure/clojure/tools/analyzer/jvm/core_test.clj

@@ -5,6 +5,7 @@
             [clojure.tools.analyzer.env :as env]
             [clojure.tools.analyzer.passes.elide-meta :refer [elides elide-meta]]
             [clojure.tools.analyzer.ast :refer [postwalk]]
+            [clojure.tools.reader :as r]
             [clojure.test :refer [deftest is]]))
 
 (defprotocol p (f [_]))
@@ -20,13 +21,16 @@
      (env/with-env (ana.jvm/global-env)
        (postwalk (ana/analyze '~form e) elide-meta))))
 
+(defn ana [form]
+  (binding [ana/macroexpand-1 ana.jvm/macroexpand-1
+            ana/create-var    ana.jvm/create-var
+            ana/parse         ana.jvm/parse
+            ana/var?          var?
+            elides            {:all #{:line :column :file}}]
+    (ana.jvm/analyze form e)))
+
 (defmacro ast1 [form]
-  `(binding [ana/macroexpand-1 ana.jvm/macroexpand-1
-             ana/create-var    ana.jvm/create-var
-             ana/parse         ana.jvm/parse
-             ana/var?          var?
-             elides            {:all #{:line :column :file}}]
-     (ana.jvm/analyze '~form e)))
+  `(ana '~form))
 
 (defmacro mexpand [form]
   `(ana.jvm/macroexpand-1 '~form e))
@@ -108,3 +112,6 @@
 (deftest analyze+eval-context-test
   (let [do-ast (ana.jvm/analyze+eval '(do 1 2 3))]
     (is (= :ctx/statement (-> do-ast :statements first :env :context)))))
+
+(deftest array_class
+  (is (ana (r/read-string "(fn [^{:tag int/2} x] (instance? int/2 x))"))))