- Modified _jvm_anewarray so it now works with generic classes.

7 files changed, 117 insertions, 49 deletions

diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index ff8863003..5a0aa0b3c 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -133,8 +133,9 @@
 (defn ^:private aba8 [analyse eval! compile-module compile-token exo-type token]
   (|case token
     ;; Arrays
-    (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_anewarray")] (&/$Cons [_ (&/$TextS ?class)] (&/$Cons ?length (&/$Nil)))))
-    (&&host/analyse-jvm-anewarray analyse exo-type ?class ?length)
+    (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_anewarray")] (&/$Cons gtype (&/$Cons ?length (&/$Nil)))))
+    (|do [=gtype (&&a-parser/parse-gclass gtype)]
+      (&&host/analyse-jvm-anewarray analyse exo-type =gtype ?length))
 
     (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_aastore")] (&/$Cons ?array (&/$Cons ?idx (&/$Cons ?elem (&/$Nil))))))
     (&&host/analyse-jvm-aastore analyse exo-type ?array ?idx ?elem)
diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index 0ccfc9a5c..b729ffd33 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -7,7 +7,7 @@
   (:require (clojure [template :refer [do-template]])
             clojure.core.match
             clojure.core.match.array
-            (lux [base :as & :refer [|let |do return fail |case assert!]]
+            (lux [base :as & :refer [|let |do return* return fail |case assert!]]
                  [type :as &type]
                  [host :as &host])
             [lux.type.host :as &host-type]
@@ -411,14 +411,15 @@
 
 (let [length-type &type/Int
       idx-type &type/Int]
-  (defn analyse-jvm-anewarray [analyse exo-type class length]
-    (|do [elem-type (&host-type/dummy-gtype class)
-          :let [array-type (&type/Data$ &host-type/array-data-tag (&/|list elem-type))]
+  (defn analyse-jvm-anewarray [analyse exo-type gclass length]
+    (|do [gtype-env &/get-type-env
+          =gclass (&host-type/instance-gtype &type/existential gtype-env gclass)
+          :let [array-type (&type/Data$ &host-type/array-data-tag (&/|list =gclass))]
           =length (&&/analyse-1 analyse length-type length)
           _ (&type/check exo-type array-type)
           _cursor &/cursor]
       (return (&/|list (&&/|meta exo-type _cursor
-                                 (&/V &&/$jvm-anewarray (&/T class =length)))))))
+                                 (&/V &&/$jvm-anewarray (&/T gclass =length gtype-env)))))))
 
   (defn analyse-jvm-aaload [analyse exo-type array idx]
     (|do [=array (&&/analyse-1+ analyse array)
@@ -574,14 +575,15 @@
                                        =ca-term (&&/analyse-1 analyse =ca-type ca-term)]
                                    (return (&/T ca-type =ca-term))))
                                ?ctor-args)
-            =body (&&env/with-local &&/jvm-this class-type
-                    (&/fold (fn [body* input*]
-                              (|do [:let [[iname itype*] input*]
-                                    itype (generic-class->type full-env itype*)]
-                                (&&env/with-local iname itype
-                                  body*)))
-                            (&&/analyse-1 analyse output-type ?body)
-                            (&/|reverse ?inputs)))]
+            =body (&/with-type-env full-env
+                    (&&env/with-local &&/jvm-this class-type
+                      (&/fold (fn [body* input*]
+                                (|do [:let [[iname itype*] input*]
+                                      itype (generic-class->type full-env itype*)]
+                                  (&&env/with-local iname itype
+                                    body*)))
+                              (&&/analyse-1 analyse output-type ?body)
+                              (&/|reverse ?inputs))))]
         (return (&/V &/$ConstructorMethodAnalysis (&/T ?anns ?gvars ?exceptions ?inputs =ctor-args =body))))
       
       (&/$VirtualMethodSyntax ?name ?anns ?gvars ?exceptions ?inputs ?output ?body)
@@ -591,14 +593,15 @@
                                ?gvars)
             :let [full-env (&/|++ class-env method-env)]
             output-type (generic-class->type full-env ?output)
-            =body (&&env/with-local &&/jvm-this class-type
-                    (&/fold (fn [body* input*]
-                              (|do [:let [[iname itype*] input*]
-                                    itype (generic-class->type full-env itype*)]
-                                (&&env/with-local iname itype
-                                  body*)))
-                            (&&/analyse-1 analyse output-type ?body)
-                            (&/|reverse ?inputs)))]
+            =body (&/with-type-env full-env
+                    (&&env/with-local &&/jvm-this class-type
+                      (&/fold (fn [body* input*]
+                                (|do [:let [[iname itype*] input*]
+                                      itype (generic-class->type full-env itype*)]
+                                  (&&env/with-local iname itype
+                                    body*)))
+                              (&&/analyse-1 analyse output-type ?body)
+                              (&/|reverse ?inputs))))]
         (return (&/V &/$VirtualMethodAnalysis (&/T ?name ?anns ?gvars ?exceptions ?inputs ?output =body))))
       
       (&/$OverridenMethodSyntax ?class-decl ?name ?anns ?gvars ?exceptions ?inputs ?output ?body)
@@ -609,14 +612,15 @@
                                ?gvars)
             :let [full-env (&/|++ super-env method-env)]
             output-type (generic-class->type full-env ?output)
-            =body (&&env/with-local &&/jvm-this class-type
-                    (&/fold (fn [body* input*]
-                              (|do [:let [[iname itype*] input*]
-                                    itype (generic-class->type full-env itype*)]
-                                (&&env/with-local iname itype
-                                  body*)))
-                            (&&/analyse-1 analyse output-type ?body)
-                            (&/|reverse ?inputs)))]
+            =body (&/with-type-env full-env
+                    (&&env/with-local &&/jvm-this class-type
+                      (&/fold (fn [body* input*]
+                                (|do [:let [[iname itype*] input*]
+                                      itype (generic-class->type full-env itype*)]
+                                  (&&env/with-local iname itype
+                                    body*)))
+                              (&&/analyse-1 analyse output-type ?body)
+                              (&/|reverse ?inputs))))]
         (return (&/V &/$OverridenMethodAnalysis (&/T ?class-decl ?name ?anns ?gvars ?exceptions ?inputs ?output =body))))
       )))
 
diff --git a/src/lux/base.clj b/src/lux/base.clj
index 78625f39c..c0c72c084 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -92,7 +92,8 @@
    "loader"
    "classes"
    "catching"
-   "module-states"])
+   "module-states"
+   "type-env"])
 
 ;; Compiler
 (deftags
@@ -640,7 +641,8 @@
      Nil$
      ;; "lux;module-states"
      (|table)
-     )))
+     ;; lux;type-env
+     (|table))))
 
 (defn init-state [_]
   (T ;; "lux;source"
@@ -1049,3 +1051,25 @@
       ($None) (|some f xs*)
       output  output)
     ))
+
+(def get-type-env
+  "(Lux TypeEnv)"
+  (fn [state]
+    (return* state (->> state (get$ $host) (get$ $type-env)))))
+
+(defn with-type-env [type-env body]
+  "(All [a] (-> TypeEnv (Lux a) (Lux a)))"
+  (fn [state]
+    (|let [state* (update$ $host #(update$ $type-env (partial |++ type-env) %)
+                           state)]
+      (|case (body state*)
+        ($Right [state** output])
+        (V $Right (T (update$ $host
+                              #(set$ $type-env
+                                     (->> state (get$ $host) (get$ $type-env))
+                                     %)
+                              state**)
+                     output))
+
+        ($Left msg)
+        (V $Left msg)))))
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index 73b5a4206..9b16a2001 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -309,8 +309,8 @@
         (&o/$jvm-caload ?array ?idx)
         (&&host/compile-jvm-caload compile-expression ?array ?idx)
 
-        (&o/$jvm-anewarray ?class ?length)
-        (&&host/compile-jvm-anewarray compile-expression ?class ?length)
+        (&o/$jvm-anewarray ?class ?length gtype-env)
+        (&&host/compile-jvm-anewarray compile-expression ?class ?length gtype-env)
 
         (&o/$jvm-aastore ?array ?idx ?elem)
         (&&host/compile-jvm-aastore compile-expression ?array ?idx ?elem)
diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj
index 009c9a9e4..19af75dce 100644
--- a/src/lux/compiler/host.clj
+++ b/src/lux/compiler/host.clj
@@ -283,7 +283,9 @@
   (do (defn <new-name> [compile ?length]
         (|do [^MethodVisitor *writer* &/get-writer
               _ (compile ?length)
-              :let [_ (.visitInsn *writer* Opcodes/L2I)]
+              :let [_ (doto *writer*
+                        &&/unwrap-long
+                        (.visitInsn Opcodes/L2I))]
               :let [_ (.visitIntInsn *writer* Opcodes/NEWARRAY <prim-type>)]]
           (return nil)))
 
@@ -326,11 +328,13 @@
   Opcodes/T_CHAR    "[C" compile-jvm-cnewarray compile-jvm-caload Opcodes/CALOAD compile-jvm-castore Opcodes/CASTORE &&/wrap-char    &&/unwrap-char
   )
 
-(defn compile-jvm-anewarray [compile ?class ?length]
+(defn compile-jvm-anewarray [compile ?gclass ?length type-env]
   (|do [^MethodVisitor *writer* &/get-writer
         _ (compile ?length)
-        :let [_ (.visitInsn *writer* Opcodes/L2I)]
-        :let [_ (.visitTypeInsn *writer* Opcodes/ANEWARRAY (&host-generics/->bytecode-class-name ?class))]]
+        :let [_ (doto *writer*
+                  &&/unwrap-long
+                  (.visitInsn Opcodes/L2I))]
+        :let [_ (.visitTypeInsn *writer* Opcodes/ANEWARRAY (&host-generics/gclass->bytecode-class-name* ?gclass type-env))]]
     (return nil)))
 
 (defn compile-jvm-aaload [compile ?array ?idx]
diff --git a/src/lux/host/generics.clj b/src/lux/host/generics.clj
index 169827789..5709fb615 100644
--- a/src/lux/host/generics.clj
+++ b/src/lux/host/generics.clj
@@ -131,6 +131,25 @@
     _
     (assert false (str 'gclass->class-name " " (&/adt->text gclass)))))
 
+;; TODO: CLEAN THIS UP, IT'S DOING A HACK BY TREATING GCLASSES AS GVARS
+(let [object-bc-name (->bytecode-class-name "java.lang.Object")]
+  (defn gclass->bytecode-class-name* [gclass type-env]
+    "(-> GenericClass Text)"
+    (|case gclass
+      (&/$GenericTypeVar name)
+      object-bc-name
+
+      (&/$GenericWildcard)
+      object-bc-name
+      
+      (&/$GenericClass name params)
+      (if (&/|get name type-env)
+        object-bc-name
+        (->bytecode-class-name name))
+
+      (&/$GenericArray param)
+      (assert false "gclass->bytecode-class-name doesn't work on arrays."))))
+
 (let [object-bc-name (->bytecode-class-name "java.lang.Object")]
   (defn gclass->bytecode-class-name [gclass]
     "(-> GenericClass Text)"
diff --git a/src/lux/type/host.clj b/src/lux/type/host.clj
index 6e783821c..b03fd9828 100644
--- a/src/lux/type/host.clj
+++ b/src/lux/type/host.clj
@@ -117,6 +117,32 @@
           (instance-param existential matchings bound)
           existential)))
 
+;; TODO: CLEAN THIS UP, IT'S DOING A HACK BY TREATING GCLASSES AS GVARS
+(defn instance-gtype [existential matchings gtype]
+  "(-> (Lux Type) (List (, Text Type)) GenericType (Lux Type))"
+  (|case gtype
+    (&/$GenericArray component-type)
+    (|do [inner-type (instance-gtype existential matchings component-type)]
+      (return (&/V &/$DataT (&/T array-data-tag (&/|list inner-type)))))
+    
+    (&/$GenericClass type-name type-params)
+    (if-let [m-type (&/|get type-name matchings)]
+      (return m-type)
+      (|do [params* (&/map% (partial instance-gtype existential matchings)
+                            type-params)]
+        (return (&/V &/$DataT (&/T type-name
+                                   params*)))))
+    
+    (&/$GenericTypeVar var-name)
+    (if-let [m-type (&/|get var-name matchings)]
+      (return m-type)
+      (fail (str "[Type Error] Unknown generic type variable: " var-name " -- " (->> matchings
+                                                                                     (&/|map &/|first)
+                                                                                     &/->seq))))
+    
+    (&/$GenericWildcard)
+    existential))
+
 ;; [Utils]
 (defn ^:private translate-params [existential super-type-params sub-type-params params]
   "(-> (List (^ java.lang.reflect.Type)) (List (^ java.lang.reflect.Type)) (List Type) (Lux (List Type)))"
@@ -224,16 +250,6 @@
         (prn 'check-host-types e [e!name a!name])
         (throw e)))))
 
-(let [Void$ (&/V &/$VariantT (&/|list))
-      gen-type (constantly Void$)]
-  (defn dummy-gtype [class]
-    (|do [class-loader &/loader]
-      (try (|let [=class (Class/forName class true class-loader)
-                  params (->> =class .getTypeParameters seq &/->list (&/|map gen-type))]
-             (return (&/V &/$DataT (&/T class params))))
-        (catch Exception e
-          (fail (str "[Type Error] Unknown type: " class)))))))
-
 (defn gtype->gclass [gtype]
   "(-> GenericType GenericClass)"
   (cond (instance? Class gtype)