Update to Java commit 1fa5b03 (2024.04.26): CLJ-2807: Adding array class symbols into the symbol space via the locked out sym/N pattern

dmiller · dmiller · commit 1792c02ce962 · 2024-07-27T11:05:15.000-04:00
diff --git a/Clojure/Clojure.Source/clojure/core_print.clj b/Clojure/Clojure.Source/clojure/core_print.clj
@@ -432,21 +432,24 @@
    Decimal "System.Decimal" })  ;; ADDED
   
 (defmethod print-method Type [^Type c, ^System.IO.TextWriter w]
-  (.Write w (.FullName c)))   ;;; .getName => .FullName
+  (if (.IsArray c)                                                   ;;; .isArray
+    (print-method (clojure.lang.Util/arrayTypeToSymbol c) w)
+    (.Write w (.FullName c))))                                       ;;; .getName => .FullName
+  
 
 (defmethod print-dup Type [^Type c, ^System.IO.TextWriter w]
   (cond
-    (.IsPrimitive c) (do                                             ;; .isPrimitive
+    (.IsPrimitive c) (do                                             ;;; .isPrimitive
                        (.Write w "#=(identity ")
                        (.Write w ^String (primitives-classnames c))
                        (.Write w ")"))
-    (.IsArray c) (do                                                 ;; .isArray ,  java.lang.Class/forName =>
+    (.IsArray c) (do                                                 ;;; .isArray ,  java.lang.Class/forName =>
                    (.Write w "#=(clojure.lang.RT/classForName \"")
-                   (.Write w (.FullName c))                           ;; .getName => .FullName
+                   (.Write w (.FullName c))                          ;;; .getName => .FullName
                    (.Write w "\")"))
     :else (do
             (.Write w "#=")
-            (.Write w (.FullName c)))))    ;;; .getName => .FullName
+            (.Write w (.FullName c)))))                              ;;; .getName => .FullName
 
 (defmethod print-method clojure.lang.BigDecimal [b, ^System.IO.TextWriter w]    ;;; java.math.BigDecimal
   (.Write w (str b))
diff --git a/Clojure/Clojure.Tests/Clojure.Tests.csproj b/Clojure/Clojure.Tests/Clojure.Tests.csproj
@@ -31,6 +31,9 @@
     <None Update="clojure\test_clojure\api.clj">
       <CopyToOutputDirectory>PreserveNewest</CopyToOutputDirectory>
     </None>
+    <None Update="clojure\test_clojure\array_symbols.clj">
+      <CopyToOutputDirectory>PreserveNewest</CopyToOutputDirectory>
+    </None>
     <None Update="clojure\test_clojure\atoms.clj">
       <CopyToOutputDirectory>PreserveNewest</CopyToOutputDirectory>
     </None>
diff --git a/Clojure/Clojure.Tests/clojure/test_clojure/array_symbols.clj b/Clojure/Clojure.Tests/clojure/test_clojure/array_symbols.clj
@@ -0,0 +1,128 @@
+﻿;   Copyright (c) Rich Hickey. All rights reserved.
+;   The use and distribution terms for this software are covered by the
+;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
+;   which can be found in the file epl-v10.html at the root of this distribution.
+;   By using this software in any fashion, you are agreeing to be bound by
+;   the terms of this license.
+;   You must not remove this notice, or any other, from this software.
+
+(ns clojure.test-clojure.array-symbols
+  (:use clojure.test)
+  (:require [clojure.test-helper :as util]))
+
+(set! *warn-on-reflection* true)
+
+;; Easiest just to rewrite this whole thing
+;(deftest test-array-symbols
+;  (is (= 'java.lang.String/1 (read-string "java.lang.String/1")))
+;  (is (= 'String/1 (read-string "String/1")))
+;  (is (= 'int/2 (read-string "int/2")))
+;  (testing "array symbol resolution"
+;    (are [str-repr klass] (= (Class/forName str-repr) klass)
+;      "[Z" (resolve 'boolean/1)
+;      "[B" (resolve 'byte/1)
+;      "[C" (resolve 'char/1)
+;      "[S" (resolve 'short/1)
+;      "[F" (resolve 'float/1)
+;      "[D" (resolve 'double/1)
+;      "[I" (resolve 'int/1)
+;      "[J" (resolve 'long/1)
+;      "[[J" (resolve 'long/2)
+;      "[Ljava.lang.Object;" (resolve 'Object/1)
+;      "[Ljava.lang.String;" (resolve 'String/1)
+;      "[[Ljava.lang.String;" (resolve 'String/2))
+;    (is (thrown? ClassNotFoundException (resolve 'ThisIsNotAClassThatCouldBeFound138/2)))
+;    (is (thrown? ClassNotFoundException (resolve 'foo.bar.ThisIsNotAClassThatCouldBeFound138/2))))
+;  (testing "array hints"
+;    (util/should-not-reflect
+;     (let [^long/1 a (long-array [1 2 3 4 99 100])]
+;       (java.util.Arrays/binarySearch a 99))))
+;  (testing "syntax quote"
+;    (is (= `byte/1 'byte/1))
+;    (is (= `byte/9 'byte/9))
+;    (is (= `java.util.UUID/1 'java.util.UUID/1))
+;    (is (= `String/1 'java.lang.String/1)))
+;  (testing "resolution"
+;    (is (= (eval 'long/1) (class (make-array Long/TYPE 0))))
+;    (is (= (resolve 'long/1) (class (make-array Long/TYPE 0))))
+;    (is (= (resolve 'String/1) (class (make-array String 0))))
+;    (is (= (resolve 'java.lang.String/1) (class (make-array String 0))))
+;    (is (= (resolve 'java.util.UUID/1) (class (make-array java.util.UUID 0))))
+;    (is (= (resolve 'String/2)
+;           (class (into-array (class (make-array String 0)) [(into-array String ["a" "b"])])))))
+;  (testing "value position"
+;    (is (= (class (make-array String 0)) String/1))
+;    (is (= [(class (make-array String 0))] [String/1])))
+;  (testing "printing"
+;    (is (= "long/1" (print-str long/1)))
+;    (is (= "byte/1" (print-str (class (make-array Byte/TYPE 0)))))
+;    (is (= "java.lang.String/2" (print-str String/2)))
+;    (is (= "[[java.lang.String/2]]" (print-str [[String/2]])))
+;    (is (= "java.util.UUID/4" (print-str java.util.UUID/4)))
+;    (is (= "[[[[[[[[[[Ljava.lang.Object;" (print-str (Class/forName "[[[[[[[[[[Ljava.lang.Object;"))))
+;    (is (= "java.lang.Object/9" (print-str (Class/forName "[[[[[[[[[Ljava.lang.Object;")))))
+;  (testing "error conditions"
+;    (is (thrown? Exception (read-string "String/1:")))
+;    (is (thrown? Exception (read-string "String/0")))
+;    (is (thrown? Exception (read-string "String/42")))
+;    (is (thrown? Exception (eval '(deftype Foo/2 [a
+
+(defn make-array-of-dim [^Type element-type ^long dim]
+  (if (<= dim 0)
+    element-type
+    (make-array-of-dim (.MakeArrayType element-type) (dec dim))))
+
+
+(deftest test-array-symbols
+  (is (= 'System.String/1 (read-string "System.String/1")))
+  (is (= 'String/1 (read-string "String/1")))
+  (is (= 'int/2 (read-string "int/2")))
+  (testing "array symbol resolution"
+    (are [str-repr klass] (= (Type/GetType str-repr) klass)
+      "System.Boolean[]" (resolve 'boolean/1)
+      "System.Byte[]" (resolve 'byte/1)
+      "System.Char[]" (resolve 'char/1)
+      "System.Int16[]" (resolve 'short/1)
+      "System.Single[]" (resolve 'float/1)
+      "System.Double[]" (resolve 'double/1)
+      "System.Int32[]" (resolve 'int/1)
+      "System.Int64[]" (resolve 'long/1)
+      "System.Int64[][]" (resolve 'long/2)
+      "System.Object[]" (resolve 'Object/1)
+      "System.String[]" (resolve 'String/1)
+      "System.String[][]" (resolve 'String/2))
+    (is (thrown? clojure.lang.TypeNotFoundException (resolve 'ThisIsNotAClassThatCouldBeFound138/2)))
+    (is (thrown? clojure.lang.TypeNotFoundException (resolve 'foo.bar.ThisIsNotAClassThatCouldBeFound138/2))))
+  (testing "array hints"
+    (util/should-not-reflect
+     (let [^long/1 a (long-array [1 2 3 4 99 100])]
+       (System.Array/BinarySearch a 99))))
+  (testing "syntax quote"
+    (is (= `byte/1 'byte/1))
+    (is (= `byte/9 'byte/9))
+    (is (= `System.Guid/1 'System.Guid/1))
+    (is (= `String/1 'String/1)))
+  (testing "resolution"
+    (is (= (eval 'long/1) (class (make-array Int64 0))))
+    (is (= (resolve 'long/1) (class (make-array Int64 0))))
+    (is (= (resolve 'String/1) (class (make-array String 0))))
+    (is (= (resolve 'System.String/1) (class (make-array String 0))))
+    (is (= (resolve 'System.Guid/1) (class (make-array System.Guid 0))))
+    (is (= (resolve 'String/2)
+           (class (into-array (class (make-array String 0)) [(into-array String ["a" "b"])])))))
+  (testing "value position"
+    (is (= (class (make-array String 0)) String/1))
+    (is (= [(class (make-array String 0))] [String/1])))
+  (testing "printing"
+    (is (= "long/1" (print-str long/1)))
+    (is (= "byte/1" (print-str (class (make-array Byte 0)))))
+    (is (= "System.String/2" (print-str String/2)))
+    (is (= "[[System.String/2]]" (print-str [[String/2]])))
+    (is (= "System.Guid/4" (print-str System.Guid/4)))
+    (is (= "System.Object[][][][][][][][][][]" (print-str (make-array-of-dim Object 10))))
+    (is (= "System.Object/9" (print-str (make-array-of-dim Object 9)))))
+  (testing "error conditions"
+    (is (thrown? Exception (read-string "String/1:")))
+    (is (thrown? Exception (read-string "String/0")))
+    (is (thrown? Exception (read-string "String/42")))
+    (is (thrown? Exception (eval '(deftype Foo/2 [a]))))))
diff --git a/Clojure/Clojure/CljCompiler/Ast/HostExpr.cs b/Clojure/Clojure/CljCompiler/Ast/HostExpr.cs
@@ -16,6 +16,7 @@
 using System.Collections.Generic;
 using System.Reflection;
 using System.Reflection.Emit;
+using System.Text;
 
 namespace clojure.lang.CljCompiler.Ast
 {
@@ -344,10 +345,14 @@ internal static Type TagToType(object tag)
             Symbol sym = tag as Symbol;
             if (sym != null)
             {
-                if (sym.Namespace == null) // if ns-qualified, can't be classname
+                if (sym.Namespace == null)
                 {
                     t = maybeSpecialTag(sym);
                 }
+                if (t == null)
+                {
+                    t = HostExpr.MaybeArrayType(sym);
+                }
             }
            
             if ( t == null )
@@ -359,6 +364,31 @@ internal static Type TagToType(object tag)
             throw new ArgumentException("Unable to resolve typename: " + tag);
         }
 
+        public static Type MaybeArrayType(Symbol sym)
+        {
+            if (sym.Namespace == null || !Util.IsPosDigit(sym.Name))
+                return null;
+
+            int dim = sym.Name[0] - '0';
+            Symbol componentTypeName = Symbol.intern(null, sym.Namespace);
+            Type componentType = Compiler.PrimType(componentTypeName);
+            if (componentType == null)
+                componentType = HostExpr.MaybeType(componentTypeName, false);
+
+            if (componentType == null)
+                throw new TypeNotFoundException("Unable to resolve component typename: " + componentTypeName);
+
+            // componentType.MakeArrayType(dim) is not what you want.  This creates .IsVariableBound designed for multiple dimensions.
+            // We are matching Java which means we have jagged arrays.
+            // Without an argument, MakeArrayType returns an SZ array -- one-dimensional, zero-based.
+            // we need to nest.
+
+            for (int i = 0; i < dim; i++)
+                componentType = componentType.MakeArrayType();
+
+            return componentType;
+        }
+
         #endregion
 
         #region Code generation
diff --git a/Clojure/Clojure/CljCompiler/Compiler.cs b/Clojure/Clojure/CljCompiler/Compiler.cs
@@ -24,6 +24,7 @@
 using System.Text.RegularExpressions;
 using System.Runtime.Serialization;
 using System.Collections;
+using System.Net;
 
 namespace clojure.lang
 {
@@ -414,8 +415,12 @@ public static Symbol resolveSymbol(Symbol sym)
             {
                 Namespace ns = namespaceFor(sym);
                 if (ns == null || (ns.Name.Name == null ? sym.Namespace == null : ns.Name.Name.Equals(sym.Namespace)))
-
+                {
+                    Type at = HostExpr.MaybeArrayType(sym);
+                    if (at != null)
+                        return Util.arrayTypeToSymbol(at);
                     return sym;
+                }
                 return Symbol.intern(ns.Name.Name, sym.Name);
             }
 
@@ -477,7 +482,12 @@ private static object ResolveIn(Namespace n, Symbol symbol, bool allowPrivate)
             {
                 Namespace ns = namespaceFor(n, symbol);
                 if (ns == null)
+                {
+                    Type at = HostExpr.MaybeArrayType(symbol);
+                    if ( at != null)
+                        return at;
                     throw new InvalidOperationException("No such namespace: " + symbol.Namespace);
+                }
 
                 Var v = ns.FindInternedVar(Symbol.intern(symbol.Name));
                 if (v == null)
@@ -517,7 +527,7 @@ public static object maybeResolveIn(Namespace n, Symbol symbol)
             {
                 Namespace ns = namespaceFor(n, symbol);
                 if (ns == null)
-                    return null;
+                    return HostExpr.MaybeArrayType(symbol);
 
                 Var v = ns.FindInternedVar(Symbol.intern(symbol.Name));
                 if (v == null)
@@ -811,6 +821,28 @@ public static Type RetType(Type tc, Type ret)
             return tc;
         }
 
+        private static Dictionary<Type,string> primTypeNamesMap = new Dictionary<Type,string>
+        {
+            { typeof(int), "int" },
+            { typeof(long), "long" },
+            { typeof(float), "float" },
+            { typeof(double), "double" },
+            { typeof(char), "char" },
+            { typeof(short), "short" },
+            { typeof(byte), "byte" },
+            { typeof(bool), "bool" },
+            { typeof(uint), "uint" },
+            { typeof(ulong), "ulong" },
+            { typeof(ushort), "ushort" },
+            { typeof(sbyte), "sbyte" },
+            { typeof(void), "void" }
+        };
+
+        public static bool TryPrimTypeToName(Type type, out string name)
+        {
+            return primTypeNamesMap.TryGetValue(type, out name);
+        }
+
         public static Type PrimType(Symbol sym)
         {
             if (sym == null)
@@ -1999,7 +2031,7 @@ private static Expr AnalyzeSymbol(Symbol symbol)
             }
             else
             {
-                if (namespaceFor(symbol) == null)
+                if (namespaceFor(symbol) == null && !Util.IsPosDigit(symbol.Name))
                 {
                     Symbol nsSym = Symbol.intern(symbol.Namespace);
                     Type t = HostExpr.MaybeType(nsSym, false);
diff --git a/Clojure/Clojure/Lib/LispReader.cs b/Clojure/Clojure/Lib/LispReader.cs
@@ -567,9 +567,15 @@ public static object InterpretToken(string rawToken, string token, string mask,
             throw new ArgumentException("Invalid token: " + rawToken);
         }
 
+        // Java originals, for comparison
+        //static Pattern symbolPat = Pattern.compile("[:]?([\\D&&[^/]].*/)?(/|[\\D&&[^/]][^/]*)");
+        //static Pattern arraySymbolPat = Pattern.compile("([\\D&&[^/:]].*)/([1-9])");
 
         //static Regex symbolPat = new Regex("[:]?([\\D&&[^/]].*/)?(/|[\\D&&[^/]][^/]*)");
+        //static readonly Regex arraySymbolPat = new Regex("([\\D&&[^/:]].*)/([1-9])");
+
         static readonly Regex symbolPat = new Regex("^[:]?([^\\p{Nd}/].*/)?(/|[^\\p{Nd}/][^/]*)$");
+        static readonly Regex arraySymbolPat = new Regex("^([^\\p{Nd}/].*/)([1-9])$");
         static readonly Regex keywordPat = new Regex("^[:]?([^/].*/)?(/|[^/][^/]*)$");
         static readonly Regex argPat = new Regex("^%(?:(&)|([1-9][0-9]*))?$");
 
@@ -656,6 +662,17 @@ static object matchSymbol(string token, string mask, Resolver resolver)
                     return Symbol.intern(ns, name);
                 }
             }
+            else
+            {
+                Match m3 = arraySymbolPat.Match(mask);
+                if ( m3.Success)
+                {
+                    string maskNS = m3.Groups[1].Value;
+                    string maskName = m3.Groups[2].Value;
+                    ExtractNamesUsingMask(token, maskNS, maskName, out string ns, out string name);
+                    return Symbol.intern(ns, name);
+                }
+            }
 
             return null;
         }
diff --git a/Clojure/Clojure/Lib/Util.cs b/Clojure/Clojure/Lib/Util.cs
@@ -810,6 +810,37 @@ internal static bool IsIntegerType(Type type)
             return false;
         }
 
+        public static bool IsPosDigit(string s)
+        {
+            if (s.Length != 1)
+                return false;
+            char c = s[0];
+            return c >= '1' && c <= '9';
+        }
+
+        public static Symbol arrayTypeToSymbol(Type t)
+        {
+            int dim = 0;
+            Type componentType = t;
+            while (componentType.IsArray)
+            {
+                dim++;
+                if (dim > 9)
+                    break;
+                componentType = componentType.GetElementType();
+            }
+
+            if (dim <= 9 && dim >= 1)
+            {
+                if (Compiler.TryPrimTypeToName(componentType, out string name))
+                    return Symbol.intern(name, dim.ToString());
+                else
+                    return Symbol.intern(componentType.FullName, dim.ToString());
+            }
+            else
+                return Symbol.intern(null, t.FullName);
+        }
+
 
         // I can hardly claim this is original.
         public static void Shuffle(IList list)
