More fiddling with types for JVM interop.

1 files changed, 73 insertions, 65 deletions

diff --git a/stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux b/stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux
index 91581c37b..61d65e67f 100644
--- a/stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux
+++ b/stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux
@@ -22,8 +22,8 @@
    ["." type
     ["." check (#+ Check) ("#@." monad)]]
    [target
-    [jvm
-     ["_." type (#+ Var Bound Primitive Generic Class Type Argument Return Typed)]]]]
+    ["." jvm #_
+     ["#" type (#+ Var Bound Primitive Generic Class Type Argument Return Typed)]]]]
   ["." // #_
    ["#." common]
    ["/#" //
@@ -336,7 +336,7 @@
       (do ////.monad
         [lengthA (typeA.with-type ..int
                    (analyse lengthC))
-         _ (typeA.infer (#.Primitive (_type.descriptor (_type.array 1 primitive-type)) (list)))]
+         _ (typeA.infer (#.Primitive (jvm.descriptor (jvm.array 1 primitive-type)) (list)))]
         (wrap (#/////analysis.Extension extension-name (list lengthA))))
 
       _
@@ -414,7 +414,7 @@
         [_ (typeA.infer lux-type)
          idxA (typeA.with-type ..int
                 (analyse idxC))
-         arrayA (typeA.with-type (#.Primitive (_type.descriptor (_type.array 1 jvm-type)) (list))
+         arrayA (typeA.with-type (#.Primitive (jvm.descriptor (jvm.array 1 jvm-type)) (list))
                   (analyse arrayC))]
         (wrap (#/////analysis.Extension extension-name (list idxA arrayA))))
 
@@ -446,7 +446,7 @@
 
 (def: (write-primitive-array-handler lux-type jvm-type)
   (-> .Type Type Handler)
-  (let [array-type (#.Primitive (_type.descriptor (_type.array 1 jvm-type)) (list))]
+  (let [array-type (#.Primitive (jvm.descriptor (jvm.array 1 jvm-type)) (list))]
     (function (_ extension-name analyse args)
       (case args
         (^ (list idxC valueC arrayC))
@@ -498,36 +498,36 @@
           (///bundle.install "length" array::length)
           (dictionary.merge (<| (///bundle.prefix "new")
                                 (|> ///bundle.empty
-                                    (///bundle.install "boolean" (new-primitive-array-handler _type.boolean))
-                                    (///bundle.install "byte" (new-primitive-array-handler _type.byte))
-                                    (///bundle.install "short" (new-primitive-array-handler _type.short))
-                                    (///bundle.install "int" (new-primitive-array-handler _type.int))
-                                    (///bundle.install "long" (new-primitive-array-handler _type.long))
-                                    (///bundle.install "float" (new-primitive-array-handler _type.float))
-                                    (///bundle.install "double" (new-primitive-array-handler _type.double))
-                                    (///bundle.install "char" (new-primitive-array-handler _type.char))
+                                    (///bundle.install "boolean" (new-primitive-array-handler jvm.boolean))
+                                    (///bundle.install "byte" (new-primitive-array-handler jvm.byte))
+                                    (///bundle.install "short" (new-primitive-array-handler jvm.short))
+                                    (///bundle.install "int" (new-primitive-array-handler jvm.int))
+                                    (///bundle.install "long" (new-primitive-array-handler jvm.long))
+                                    (///bundle.install "float" (new-primitive-array-handler jvm.float))
+                                    (///bundle.install "double" (new-primitive-array-handler jvm.double))
+                                    (///bundle.install "char" (new-primitive-array-handler jvm.char))
                                     (///bundle.install "object" array::new::object))))
           (dictionary.merge (<| (///bundle.prefix "read")
                                 (|> ///bundle.empty
-                                    (///bundle.install "boolean" (read-primitive-array-handler ..boolean _type.boolean))
-                                    (///bundle.install "byte" (read-primitive-array-handler ..byte _type.byte))
-                                    (///bundle.install "short" (read-primitive-array-handler ..short _type.short))
-                                    (///bundle.install "int" (read-primitive-array-handler ..int _type.int))
-                                    (///bundle.install "long" (read-primitive-array-handler ..long _type.long))
-                                    (///bundle.install "float" (read-primitive-array-handler ..float _type.float))
-                                    (///bundle.install "double" (read-primitive-array-handler ..double _type.double))
-                                    (///bundle.install "char" (read-primitive-array-handler ..char _type.char))
+                                    (///bundle.install "boolean" (read-primitive-array-handler ..boolean jvm.boolean))
+                                    (///bundle.install "byte" (read-primitive-array-handler ..byte jvm.byte))
+                                    (///bundle.install "short" (read-primitive-array-handler ..short jvm.short))
+                                    (///bundle.install "int" (read-primitive-array-handler ..int jvm.int))
+                                    (///bundle.install "long" (read-primitive-array-handler ..long jvm.long))
+                                    (///bundle.install "float" (read-primitive-array-handler ..float jvm.float))
+                                    (///bundle.install "double" (read-primitive-array-handler ..double jvm.double))
+                                    (///bundle.install "char" (read-primitive-array-handler ..char jvm.char))
                                     (///bundle.install "object" array::read::object))))
           (dictionary.merge (<| (///bundle.prefix "write")
                                 (|> ///bundle.empty
-                                    (///bundle.install "boolean" (write-primitive-array-handler ..boolean _type.boolean))
-                                    (///bundle.install "byte" (write-primitive-array-handler ..byte _type.byte))
-                                    (///bundle.install "short" (write-primitive-array-handler ..short _type.short))
-                                    (///bundle.install "int" (write-primitive-array-handler ..int _type.int))
-                                    (///bundle.install "long" (write-primitive-array-handler ..long _type.long))
-                                    (///bundle.install "float" (write-primitive-array-handler ..float _type.float))
-                                    (///bundle.install "double" (write-primitive-array-handler ..double _type.double))
-                                    (///bundle.install "char" (write-primitive-array-handler ..char _type.char))
+                                    (///bundle.install "boolean" (write-primitive-array-handler ..boolean jvm.boolean))
+                                    (///bundle.install "byte" (write-primitive-array-handler ..byte jvm.byte))
+                                    (///bundle.install "short" (write-primitive-array-handler ..short jvm.short))
+                                    (///bundle.install "int" (write-primitive-array-handler ..int jvm.int))
+                                    (///bundle.install "long" (write-primitive-array-handler ..long jvm.long))
+                                    (///bundle.install "float" (write-primitive-array-handler ..float jvm.float))
+                                    (///bundle.install "double" (write-primitive-array-handler ..double jvm.double))
+                                    (///bundle.install "char" (write-primitive-array-handler ..char jvm.char))
                                     (///bundle.install "object" array::write::object))))
           )))
 
@@ -1129,10 +1129,17 @@
   #Special
   #Interface)
 
+(def: reflection-arguments
+  (-> (List Text) (Operation (List Text)))
+  (|>> (monad.map error.monad jvm.parse-signature)
+       (:: error.monad map (list@map jvm.reflection-class))
+       ////.lift))
+
 (def: (check-method class method-name method-style arg-classes method)
   (-> (java/lang/Class java/lang/Object) Text Method-Style (List Text) Method (Operation Bit))
   (do ////.monad
-    [parameters (|> (Method::getGenericParameterTypes method)
+    [arg-classes (reflection-arguments arg-classes)
+     parameters (|> (Method::getGenericParameterTypes method)
                     array.to-list
                     (monad.map @ java-type-to-parameter))
      #let [modifiers (Method::getModifiers method)]
@@ -1167,7 +1174,8 @@
 (def: (check-constructor class arg-classes constructor)
   (-> (java/lang/Class java/lang/Object) (List Text) (Constructor java/lang/Object) (Operation Bit))
   (do ////.monad
-    [parameters (|> (Constructor::getGenericParameterTypes constructor)
+    [arg-classes (reflection-arguments arg-classes)
+     parameters (|> (Constructor::getGenericParameterTypes constructor)
                     array.to-list
                     (monad.map @ java-type-to-parameter))]
     (wrap (and (java/lang/Object::equals class (Constructor::getDeclaringClass constructor))
@@ -1469,7 +1477,7 @@
 (def: (generic-type mapping generic)
   (-> Mapping Generic (Check .Type))
   (case generic
-    (#_type.Var var)
+    (#jvm.Var var)
     (case (dictionary.get var mapping)
       #.None
       (check.throw unknown-jvm-type-var var)
@@ -1477,7 +1485,7 @@
       (#.Some type)
       (check@wrap type))
     
-    (#_type.Wildcard wildcard)
+    (#jvm.Wildcard wildcard)
     (case wildcard
       #.None
       (do check.monad
@@ -1488,13 +1496,13 @@
       (do check.monad
         [limitT (generic-type mapping limit)]
         (case bound
-          #_type.Lower
+          #jvm.Lower
           (wrap (lower-relationship-type limitT))
           
-          #_type.Upper
+          #jvm.Upper
           (wrap (upper-relationship-type limitT)))))
     
-    (#_type.Class name parameters)
+    (#jvm.Class name parameters)
     (do check.monad
       [parametersT+ (monad.map @ (generic-type mapping) parameters)]
       (wrap (#.Primitive name parametersT+)))))
@@ -1508,24 +1516,24 @@
 (def: (jvm-type mapping type)
   (-> Mapping Type (Check .Type))
   (case type
-    (#_type.Primitive primitive)
+    (#jvm.Primitive primitive)
     (check@wrap (case primitive
-                  #_type.Boolean ..boolean
-                  #_type.Byte ..byte
-                  #_type.Short ..short
-                  #_type.Int ..int
-                  #_type.Long ..long
-                  #_type.Float ..float
-                  #_type.Double ..double
-                  #_type.Char ..char))
+                  #jvm.Boolean ..boolean
+                  #jvm.Byte ..byte
+                  #jvm.Short ..short
+                  #jvm.Int ..int
+                  #jvm.Long ..long
+                  #jvm.Float ..float
+                  #jvm.Double ..double
+                  #jvm.Char ..char))
     
-    (#_type.Generic generic)
+    (#jvm.Generic generic)
     (generic-type mapping generic)
     
-    (#_type.Array type)
+    (#jvm.Array type)
     (case type
-      (#_type.Primitive primitive)
-      (check@wrap (#.Primitive (_type.descriptor (_type.array 1 type)) (list)))
+      (#jvm.Primitive primitive)
+      (check@wrap (#.Primitive (jvm.descriptor (jvm.array 1 type)) (list)))
 
       _
       (do check.monad
@@ -1625,24 +1633,24 @@
 (def: (generic-analysis generic)
   (-> Generic Analysis)
   (case generic
-    (#_type.Var var)
+    (#jvm.Var var)
     (/////analysis.text var)
     
-    (#_type.Wildcard wildcard)
+    (#jvm.Wildcard wildcard)
     (case wildcard
       #.None
       (/////analysis.constant ["" "?"])
       
       (#.Some [bound limit])
       (/////analysis.tuple (list (case bound
-                                   #_type.Lower
+                                   #jvm.Lower
                                    (/////analysis.constant ["" ">"])
                                    
-                                   #_type.Upper
+                                   #jvm.Upper
                                    (/////analysis.constant ["" "<"]))
                                  (generic-analysis limit))))
     
-    (#_type.Class name parameters)
+    (#jvm.Class name parameters)
     (/////analysis.tuple (list& (/////analysis.text name)
                                 (list@map generic-analysis parameters)))))
 
@@ -1667,21 +1675,21 @@
 (def: (type-analysis type)
   (-> Type Analysis)
   (case type
-    (#_type.Primitive primitive)
+    (#jvm.Primitive primitive)
     (case primitive
-      #_type.Boolean (/////analysis.constant ["" "boolean"])
-      #_type.Byte (/////analysis.constant ["" "byte"])
-      #_type.Short (/////analysis.constant ["" "short"])
-      #_type.Int (/////analysis.constant ["" "int"])
-      #_type.Long (/////analysis.constant ["" "long"])
-      #_type.Float (/////analysis.constant ["" "float"])
-      #_type.Double (/////analysis.constant ["" "double"])
-      #_type.Char (/////analysis.constant ["" "char"]))
+      #jvm.Boolean (/////analysis.constant ["" "boolean"])
+      #jvm.Byte (/////analysis.constant ["" "byte"])
+      #jvm.Short (/////analysis.constant ["" "short"])
+      #jvm.Int (/////analysis.constant ["" "int"])
+      #jvm.Long (/////analysis.constant ["" "long"])
+      #jvm.Float (/////analysis.constant ["" "float"])
+      #jvm.Double (/////analysis.constant ["" "double"])
+      #jvm.Char (/////analysis.constant ["" "char"]))
     
-    (#_type.Generic generic)
+    (#jvm.Generic generic)
     (generic-analysis generic)
     
-    (#_type.Array type)
+    (#jvm.Array type)
     (/////analysis.tuple (list (type-analysis type)))))
 
 (def: (return-analysis return)