array classes

babashka · Oct 10, 2024 · bca55a2 · bca55a2
1 parent 5d33aaa
commit bca55a2
Show file tree

Hide file tree

Showing 5 changed files with 80 additions and 18 deletions.
diff --git a/src/sci/impl/analyzer.cljc b/src/sci/impl/analyzer.cljc
@@ -1802,14 +1802,14 @@
             nil))))))
 
 #?(:clj
-   (defn analyze-interop-ifn [_ctx expr [^Class clazz meth]]
+   (defn analyze-interop [_ctx expr [^Class clazz meth]]
      (let [meth (str meth)
            stack (assoc (meta expr)
                         :ns @utils/current-ns
                         :file @utils/current-file)]
        (if-let [_fld (try (Reflector/getStaticField ^Class clazz ^String meth)
-                         (catch IllegalArgumentException _
-                           nil))]
+                          (catch IllegalArgumentException _
+                            nil))]
          (sci.impl.types/->Node
            (interop/get-static-field clazz meth)
            stack)
@@ -1866,8 +1866,8 @@
                                     (sci.impl.types/->Node
                                      (faster/deref-1 v)
                                      nil))))
-                              (:sci.impl.analyzer/interop-ifn mv)
-                              (analyze-interop-ifn ctx expr v)
+                              (:sci.impl.analyzer/interop mv)
+                              (analyze-interop ctx expr v)
                               :else v))
        ;; don't evaluate records, this check needs to go before map?
        ;; since a record is also a map

diff --git a/src/sci/impl/interop.cljc b/src/sci/impl/interop.cljc
@@ -137,3 +137,35 @@
 
 (defn resolve-class [ctx sym]
   (:class (resolve-class-opts ctx sym)))
+
+#?(:clj
+   (def prim->class
+     {'int Integer/TYPE
+      'ints (Class/forName "[I")
+      'long Long/TYPE
+      'longs (Class/forName "[J")
+      'float Float/TYPE
+      'floats (Class/forName "[F")
+      'double Double/TYPE
+      'doubles (Class/forName "[D")
+      'void Void/TYPE
+      'short Short/TYPE
+      'shorts (Class/forName "[S")
+      'boolean Boolean/TYPE
+      'booleans (Class/forName "[Z")
+      'byte Byte/TYPE
+      'bytes (Class/forName "[B")
+      'char Character/TYPE
+      'chars (Class/forName "[C")}))
+
+#?(:clj
+   (def ->array-class
+     (memoize (fn [clazz dim]
+                (class (make-array clazz dim))))))
+
+#?(:clj
+   (defn resolve-array-class [ctx sym-ns ^String sym-name-str]
+     (when-let [clazz (or (resolve-class ctx sym-ns)
+                          (get prim->class sym-ns))]
+       (let [dim (- (int (.charAt sym-name-str 0)) 49)]
+         (->array-class clazz dim)))))
diff --git a/src/sci/impl/parser.cljc b/src/sci/impl/parser.cljc
@@ -94,17 +94,23 @@
                   (symbol current-ns-str sym-name-str)))))
         ret (if-not sym-ns
               (res-without-sym sym)
-              (let [nss (get env :namespaces)]
-                (if (get nss sym-ns)
-                  sym
-                  (if-let [ns (get aliases sym-ns)]
-                    (symbol (str ns) (name sym))
-                    #?(:cljs
-                       ;; This enables using `(fs/readFileSync) mode in macros, e.g. in nbb
-                       (if-let [import (-> nss (get current-ns) :imports (get sym-ns))]
-                         (symbol (str import) (name sym))
-                         sym)
-                       :clj sym)))))]
+              (let [sym-name (name sym)]
+                (or
+                 #?(:clj (when (and (= 1 (.length sym-name))
+                                    (Character/isDigit (.charAt sym-name 0)))
+                           (when-let [clazz ^Class (interop/resolve-array-class ctx sym-ns sym-name)]
+                             (symbol (.getName (.getComponentType clazz)) sym-name))))
+                 (let [nss (get env :namespaces)]
+                   (if (get nss sym-ns)
+                     sym
+                     (if-let [ns (get aliases sym-ns)]
+                       (symbol (str ns) sym-name)
+                       #?(:cljs
+                          ;; This enables using `(fs/readFileSync) mode in macros, e.g. in nbb
+                          (if-let [import (-> nss (get current-ns) :imports (get sym-ns))]
+                            (symbol (str import) (name sym))
+                            sym)
+                          :clj sym)))))))]
     ret))
 
 (defn throw-eval-read [_]

diff --git a/src/sci/impl/resolve.cljc b/src/sci/impl/resolve.cljc
@@ -40,7 +40,8 @@
   ([ctx sym call?] (lookup* ctx sym call? false))
   ([ctx sym call? only-var?]
    (let [sym-ns (some-> (namespace sym) symbol)
-         sym-name (symbol (name sym))
+         sym-name-str (name sym)
+         sym-name (symbol sym-name-str)
          env (faster/get-2 ctx :env)
          env @env
          cnn (utils/current-ns-name)
@@ -51,6 +52,11 @@
          sym-ns (get (:ns-aliases env) sym-ns sym-ns)]
      (if sym-ns
        (or
+        #?(:clj
+           (when (and (= 1 (.length sym-name-str))
+                      (Character/isDigit (.charAt sym-name-str 0)))
+             (when-let [clazz (interop/resolve-array-class ctx sym-ns sym-name-str)]
+               [sym clazz])))
         (when
             #?(:clj (= 'clojure.core sym-ns)
                :cljs (or (= 'clojure.core sym-ns)
@@ -69,7 +75,7 @@
                        #?(:clj
                           (with-meta
                             [clazz sym-name]
-                            {:sci.impl.analyzer/interop-ifn true})
+                            {:sci.impl.analyzer/interop true})
                           :cljs
                           (let [stack (assoc (meta sym)
                                              :file @utils/current-file

diff --git a/test/sci/interop_test.cljc b/test/sci/interop_test.cljc
@@ -126,6 +126,24 @@
      (is (= [1 2 3] (eval* "(map String/.length [\"1\" \"22\" \"333\"])")))
      (is (= ["1" "22" "333"] (eval* "(map String/new [\"1\" \"22\" \"333\"])")))))
 
+#?(:clj
+   (deftest clojure-1_12-array-test
+     (is (= (class (make-array Long/TYPE 0)) (eval* "long/1") ))
+     (is (= (class (make-array Integer/TYPE 0)) (eval* "int/1")))
+     (is (= (class (make-array Double/TYPE 0)) (eval* "double/1") ))
+     (is (= (class (make-array Short/TYPE 0)) (eval* "short/1") ))
+     (is (= (class (make-array Boolean/TYPE 0)) (eval* "boolean/1")))
+     (is (= (class (make-array Byte/TYPE 0)) (eval* "byte/1")))
+     (is (= (class (make-array Float/TYPE 0)) (eval* "float/1")))
+     (is (= (class (make-array String 0)) (eval* "String/1")))
+     (is (= (class (make-array String 0)) (eval* "java.lang.String/1")))
+     (is (= (symbol "byte/1") (eval* "`byte/1")))
+     (is (= (symbol "byte/3") (eval* "`byte/3")))
+     (is (= (symbol "java.util.UUID/1") (eval* "`java.util.UUID/1")))
+     (is (= (symbol "java.lang.String/1") (eval* "`String/1")))
+     (is (= (symbol "java.lang.String/1") (eval* "`java.lang.String/1")))
+     (is (= [(symbol "long/2")] (eval* "['long/2]") (eval* "`[~'long/2]")))))
+
 (when-not tu/native?
   (deftest exception-data
     (testing "top-level interop forms have line and column data"