Properly handling variance for arrays to avoid invalid subtyping.

1 files changed, 42 insertions, 24 deletions

diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux
index 95915309c..6d7804b9a 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux
@@ -65,7 +65,9 @@
    ["/[1]" // "_"
     [generation
      [jvm
-      ["[0]" runtime]]]
+      ["[0]" runtime]
+      ["[0]" function "_"
+       ["[1]" abstract]]]]
     ["/[1]" // "_"
      ["[0]" generation]
      ["[0]" directive]
@@ -387,6 +389,9 @@
             [(reflection.reflection reflection.char)    [box.char jvm.char]])
       (dictionary.of_list text.hash)))
 
+(template: (lux_array_type :read: :write:)
+  [{.#Primitive (static array.type_name) (list {.#Apply :write: {.#Apply :read: _Mutable}})}])
+
 (def: (jvm_type luxT)
   (-> .Type (Operation (Type Value)))
   (case luxT
@@ -401,7 +406,7 @@
       {.#None}
       (/////analysis.except ..non_jvm_type luxT))
 
-    (pattern {.#Primitive (static array.type_name) (list elemT)})
+    (pattern (lux_array_type elemT _))
     (phase#each jvm.array (jvm_type elemT))
 
     {.#Primitive class parametersT}
@@ -432,6 +437,9 @@
 
     {.#Ex _}
     (phase#in (jvm.class ..object_class (list)))
+
+    {.#Function _}
+    (phase#in function.class)
     
     _
     (/////analysis.except ..non_jvm_type luxT)))
@@ -467,13 +475,16 @@
     (case args
       (pattern (list arrayC))
       (<| typeA.with_var
-          (function (_ [@var :var:]))
+          (function (_ [@read :read:]))
+          typeA.with_var
+          (function (_ [@write :write:]))
           (do phase.monad
             [_ (typeA.inference ..int)
-             arrayA (<| (typeA.expecting (.type (array.Array :var:)))
+             arrayA (<| (typeA.expecting (.type (array.Array' :read: :write:)))
                         (analyse archive arrayC))
-             :var: (typeA.check (check.clean (list) :var:))
-             arrayJT (jvm_array_type (.type (array.Array :var:)))]
+             :read: (typeA.check (check.clean (list) :read:))
+             :write: (typeA.check (check.clean (list) :write:))
+             arrayJT (jvm_array_type (.type (array.Array' :read: :write:)))]
             (in {/////analysis.#Extension extension_name (list (/////analysis.text (..signature arrayJT))
                                                                arrayA)})))
 
@@ -520,8 +531,7 @@
 (def: (check_parameter objectT)
   (-> .Type (Operation (Type Parameter)))
   (case objectT
-    (pattern {.#Primitive (static array.type_name)
-                          (list elementT)})
+    (pattern (lux_array_type elementT _))
     (/////analysis.except ..non_parameter objectT)
     
     {.#Primitive name parameters}
@@ -573,6 +583,9 @@
       {.#None}
       (/////analysis.except ..non_parameter objectT))
 
+    {.#Function _}
+    (phase#in function.class)
+
     _
     (/////analysis.except ..non_parameter objectT)))
 
@@ -613,9 +626,8 @@
 
               ... else
               (phase#in (jvm.class name (list)))))
-    
-    (pattern {.#Primitive (static array.type_name)
-                          (list elementT)})
+
+    (pattern (lux_array_type elementT _))
     (|> elementT
         check_jvm
         (phase#each jvm.array))
@@ -701,15 +713,18 @@
     (case args
       (pattern (list idxC arrayC))
       (<| typeA.with_var
-          (function (_ [@var :var:]))
+          (function (_ [@read :read:]))
+          typeA.with_var
+          (function (_ [@write :write:]))
           (do phase.monad
-            [_ (typeA.inference :var:)
-             arrayA (<| (typeA.expecting (.type (array.Array :var:)))
+            [_ (typeA.inference :read:)
+             arrayA (<| (typeA.expecting (.type (array.Array' :read: :write:)))
                         (analyse archive arrayC))
-             :var: (typeA.check (check.clean (list) :var:))
-             arrayJT (jvm_array_type (.type (array.Array :var:)))
              idxA (<| (typeA.expecting ..int)
-                      (analyse archive idxC))]
+                      (analyse archive idxC))
+             :read: (typeA.check (check.clean (list) :read:))
+             :write: (typeA.check (check.clean (list) :write:))
+             arrayJT (jvm_array_type (.type (array.Array' :read: :write:)))]
             (in {/////analysis.#Extension extension_name (list (/////analysis.text (..signature arrayJT))
                                                                idxA
                                                                arrayA)})))
@@ -745,17 +760,20 @@
     (case args
       (pattern (list idxC valueC arrayC))
       (<| typeA.with_var
-          (function (_ [@var :var:]))
+          (function (_ [@read :read:]))
+          typeA.with_var
+          (function (_ [@write :write:]))
           (do phase.monad
-            [_ (typeA.inference (.type (array.Array :var:)))
-             arrayA (<| (typeA.expecting (.type (array.Array :var:)))
+            [_ (typeA.inference (.type (array.Array' :read: :write:)))
+             arrayA (<| (typeA.expecting (.type (array.Array' :read: :write:)))
                         (analyse archive arrayC))
-             :var: (typeA.check (check.clean (list) :var:))
-             arrayJT (jvm_array_type (.type (array.Array :var:)))
              idxA (<| (typeA.expecting ..int)
                       (analyse archive idxC))
-             valueA (<| (typeA.expecting :var:)
-                        (analyse archive valueC))]
+             valueA (<| (typeA.expecting :write:)
+                        (analyse archive valueC))
+             :read: (typeA.check (check.clean (list) :read:))
+             :write: (typeA.check (check.clean (list) :write:))
+             arrayJT (jvm_array_type (.type (array.Array' :read: :write:)))]
             (in {/////analysis.#Extension extension_name (list (/////analysis.text (..signature arrayJT))
                                                                idxA
                                                                valueA