- Now requiring parameterized classes everywhere when invoking methods.

2 files changed, 74 insertions, 65 deletions

diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index 704e4d4c2..8de389e56 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -74,6 +74,22 @@
     (|let [[file line col] meta]
       (str "@ " file "," line "," col "\n" msg))))
 
+(defn ^:private fail-with-loc [msg]
+  (fn [state]
+    (fail* (add-loc (&/get$ &/$cursor state) msg))))
+
+(defn ^:private parse-generic-class [sample]
+  "(-> AST (Lux GenericClass))"
+  (|case sample
+    [_ (&/$FormS (&/$Cons [_ (&/$TextS ?name)]
+                          (&/$Cons [_ (&/$TupleS ?params)]
+                                   (&/$Nil))))]
+    (|do [=params (&/map% parse-generic-class ?params)]
+      (return (&/T ?name =params)))
+
+    _
+    (fail-with-loc (str "[Analyser Error] Wrong syntax for generic class: " (&/show-ast sample)))))
+
 (defn ^:private aba10 [analyse eval! compile-module compile-token exo-type token]
   (|case token
     ;; Arrays
@@ -123,8 +139,7 @@
     (&&host/analyse-jvm-laload analyse exo-type ?array ?idx)
 
     _
-    #(fail* (add-loc (&/get$ &/$cursor %)
-                     (str "[Analyser Error] Unknown syntax: " (prn-str (&/show-ast (&/T (&/T "" -1 -1) token))))))))
+    (fail-with-loc (str "[Analyser Error] Unknown syntax: " (prn-str (&/show-ast (&/T (&/T "" -1 -1) token)))))))
 
 (defn ^:private aba9 [analyse eval! compile-module compile-token exo-type token]
   (|case token
@@ -325,12 +340,13 @@
     (&&host/analyse-jvm-instanceof analyse exo-type ?class ?object)
     
     (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_new")]
-                       (&/$Cons [_ (&/$TextS ?class)]
+                       (&/$Cons ?poly-class
                                 (&/$Cons [_ (&/$TupleS ?classes)]
                                          (&/$Cons [_ (&/$TupleS ?args)]
                                                   (&/$Nil))))))
-    (|do [=classes (&/map% extract-text ?classes)]
-      (&&host/analyse-jvm-new analyse exo-type ?class =classes ?args))
+    (|do [=generic-class (parse-generic-class ?poly-class)
+          =classes (&/map% extract-text ?classes)]
+      (&&host/analyse-jvm-new analyse exo-type =generic-class =classes ?args))
 
     (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_getstatic")]
                        (&/$Cons [_ (&/$TextS ?class)]
@@ -361,43 +377,47 @@
     (&&host/analyse-jvm-putfield analyse exo-type ?class ?field ?value ?object)
 
     (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_invokestatic")]
-                       (&/$Cons [_ (&/$TextS ?class)]
+                       (&/$Cons ?poly-class
                                 (&/$Cons [_ (&/$TextS ?method)]
-                                         (&/$Cons [_ (&/$TupleS ?classes)]
+                                         (&/$Cons [_ (&/$TupleS ?arg-classes)]
                                                   (&/$Cons [_ (&/$TupleS ?args)]
                                                            (&/$Nil)))))))
-    (|do [=classes (&/map% extract-text ?classes)]
-      (&&host/analyse-jvm-invokestatic analyse exo-type ?class ?method =classes ?args))
+    (|do [=generic-class (parse-generic-class ?poly-class)
+          =arg-classes (&/map% parse-generic-class ?arg-classes)]
+      (&&host/analyse-jvm-invokestatic analyse exo-type =generic-class ?method =arg-classes ?args))
 
     (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_invokevirtual")]
-                       (&/$Cons [_ (&/$TextS ?class)]
+                       (&/$Cons ?poly-class
                                 (&/$Cons [_ (&/$TextS ?method)]
-                                         (&/$Cons [_ (&/$TupleS ?classes)]
+                                         (&/$Cons [_ (&/$TupleS ?arg-classes)]
                                                   (&/$Cons ?object
                                                            (&/$Cons [_ (&/$TupleS ?args)]
                                                                     (&/$Nil))))))))
-    (|do [=classes (&/map% extract-text ?classes)]
-      (&&host/analyse-jvm-invokevirtual analyse exo-type ?class ?method =classes ?object ?args))
+    (|do [=generic-class (parse-generic-class ?poly-class)
+          =arg-classes (&/map% parse-generic-class ?arg-classes)]
+      (&&host/analyse-jvm-invokevirtual analyse exo-type =generic-class ?method =arg-classes ?object ?args))
 
     (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_invokeinterface")]
-                       (&/$Cons [_ (&/$TextS ?class)]
+                       (&/$Cons ?poly-class
                                 (&/$Cons [_ (&/$TextS ?method)]
-                                         (&/$Cons [_ (&/$TupleS ?classes)]
+                                         (&/$Cons [_ (&/$TupleS ?arg-classes)]
                                                   (&/$Cons ?object
                                                            (&/$Cons [_ (&/$TupleS ?args)]
                                                                     (&/$Nil))))))))
-    (|do [=classes (&/map% extract-text ?classes)]
-      (&&host/analyse-jvm-invokeinterface analyse exo-type ?class ?method =classes ?object ?args))
+    (|do [=generic-class (parse-generic-class ?poly-class)
+          =arg-classes (&/map% parse-generic-class ?arg-classes)]
+      (&&host/analyse-jvm-invokeinterface analyse exo-type =generic-class ?method =arg-classes ?object ?args))
 
     (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_invokespecial")]
-                       (&/$Cons [_ (&/$TextS ?class)]
+                       (&/$Cons ?poly-class
                                 (&/$Cons [_ (&/$TextS ?method)]
-                                         (&/$Cons [_ (&/$TupleS ?classes)]
+                                         (&/$Cons [_ (&/$TupleS ?arg-classes)]
                                                   (&/$Cons ?object
                                                            (&/$Cons [_ (&/$TupleS ?args)]
                                                                     (&/$Nil))))))))
-    (|do [=classes (&/map% extract-text ?classes)]
-      (&&host/analyse-jvm-invokespecial analyse exo-type ?class ?method =classes ?object ?args))
+    (|do [=generic-class (parse-generic-class ?poly-class)
+          =arg-classes (&/map% parse-generic-class ?arg-classes)]
+      (&&host/analyse-jvm-invokespecial analyse exo-type =generic-class ?method =arg-classes ?object ?args))
 
     ;; Exceptions
     (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_try")]
diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index 46f4b1f1c..92550f0fb 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -113,23 +113,6 @@
     _
     type))
 
-(defn ^:private clean-gtype-var [idx gtype-var]
-  (|let [(&/$VarT id) gtype-var]
-    (|do [? (&type/bound? id)]
-      (if ?
-        (|do [real-type (&type/deref id)]
-          (return (&/T idx real-type)))
-        (return (&/T (+ 2 idx) (&type/Bound$ idx)))))))
-
-(defn ^:private clean-gtype-vars [gtype-vars]
-  (|do [[_ clean-types] (&/fold% (fn [idx+types gtype-var]
-                                   (|do [:let [[idx types] idx+types]
-                                         [idx* real-type] (clean-gtype-var idx gtype-var)]
-                                     (return (&/T idx* (&/Cons$ real-type types)))))
-                                 (&/T 1 (&/|list))
-                                 gtype-vars)]
-    (return clean-types)))
-
 (defn ^:private make-gtype [class-name type-args]
   "(-> Text (List Type) Type)"
   (&/fold (fn [base-type type-arg]
@@ -265,7 +248,11 @@
     (return (&/|list (&&/|meta output-type _cursor
                                (&/V &&/$jvm-instanceof (&/T class =object)))))))
 
-(defn ^:private analyse-method-call-helper [analyse gret gtype-env gtype-vars gtype-args args]
+(defn ^:private instance-generic-type [desc]
+  (|let [[gc-name gc-params] desc]
+    (&type/Data$ gc-name (&/|map instance-generic-type gc-params))))
+
+(defn ^:private analyse-method-call-helper [analyse gret gc-params gtype-env gtype-vars gtype-args args]
   (|case gtype-vars
     (&/$Nil)
     (|do [arg-types (&/map% (partial &host-type/instance-param &type/existential gtype-env) gtype-args)
@@ -274,59 +261,60 @@
       (return (&/T =gret =args)))
     
     (&/$Cons ^TypeVariable gtv gtype-vars*)
-    (&type/with-var
-      (fn [$var]
-        (|let [gtype-env* (&/Cons$ (&/T (.getName gtv) $var) gtype-env)]
-          (analyse-method-call-helper analyse gret gtype-env* gtype-vars* gtype-args args))))
+    (|let [gtype-env* (&/Cons$ (&/T (.getName gtv) (->> gc-params &/|head instance-generic-type))
+                               gtype-env)]
+      (analyse-method-call-helper analyse gret (&/|tail gc-params) gtype-env* gtype-vars* gtype-args args))
     ))
 
 (let [dummy-type-param (&type/Data$ "java.lang.Object" (&/|list))]
   (do-template [<name> <tag> <only-interface?>]
-    (defn <name> [analyse exo-type class method classes object args]
+    (defn <name> [analyse exo-type generic-class method arg-classes object args]
       (|do [class-loader &/loader
-            _ (try (assert! (let [=class (Class/forName class true class-loader)]
+            :let [[gc-name gc-params] generic-class]
+            _ (try (assert! (let [=class (Class/forName gc-name true class-loader)]
                               (= <only-interface?> (.isInterface =class)))
                             (if <only-interface?>
                               (str "[Analyser Error] Can only invoke method \"" method "\"" " on interface.")
                               (str "[Analyser Error] Can only invoke method \"" method "\"" " on class.")))
                 (catch Exception e
-                  (fail (str "[Analyser Error] Unknown class: " class))))
+                  (fail (str "[Analyser Error] Unknown class: " gc-name))))
             [gret exceptions parent-gvars gvars gargs] (if (= "<init>" method)
                                                          (return (&/T Void/TYPE &/Nil$ &/Nil$ &/Nil$ &/Nil$))
-                                                         (&host/lookup-virtual-method class-loader class method classes))
+                                                         (&host/lookup-virtual-method class-loader gc-name method arg-classes))
             _ (ensure-catching exceptions)
             =object (&&/analyse-1+ analyse object)
             [sub-class sub-params] (ensure-object (&&/expr-type* =object))
-            (&/$DataT super-class* super-params*) (&host-type/->super-type &type/existential class-loader class sub-class sub-params)
+            (&/$DataT super-class* super-params*) (&host-type/->super-type &type/existential class-loader gc-name sub-class sub-params)
             :let [_ (prn '<name> sub-class '-> super-class* (&/|length parent-gvars) (&/|length super-params*))
                   gtype-env (&/fold2 (fn [m ^TypeVariable g t] (&/Cons$ (&/T (.getName g) t) m))
                                      (&/|table)
                                      parent-gvars
                                      super-params*)]
-            [output-type =args] (analyse-method-call-helper analyse gret gtype-env gvars gargs args)
+            [output-type =args] (analyse-method-call-helper analyse gret gc-params gtype-env gvars gargs args)
             _ (&type/check exo-type (as-otype+ output-type))
             _cursor &/cursor]
         (return (&/|list (&&/|meta exo-type _cursor
-                                   (&/V <tag> (&/T class method classes =object =args output-type)))))))
+                                   (&/V <tag> (&/T gc-name method arg-classes =object =args output-type)))))))
 
     analyse-jvm-invokevirtual   &&/$jvm-invokevirtual   false
     analyse-jvm-invokespecial   &&/$jvm-invokespecial   false
     analyse-jvm-invokeinterface &&/$jvm-invokeinterface true
     ))
 
-(defn analyse-jvm-invokestatic [analyse exo-type class method classes args]
+(defn analyse-jvm-invokestatic [analyse exo-type generic-class method arg-classes args]
   (|do [class-loader &/loader
-        [gret exceptions parent-gvars gvars gargs] (&host/lookup-static-method class-loader class method classes)
+        :let [[gc-name gc-params] generic-class]
+        [gret exceptions parent-gvars gvars gargs] (&host/lookup-static-method class-loader gc-name method arg-classes)
         _ (ensure-catching exceptions)
         =args (&/map2% (fn [_class _arg]
                          (&&/analyse-1 analyse (&host-type/class-name->type _class) _arg))
-                       classes
+                       arg-classes
                        args)
         :let [output-type (&host-type/class->type (cast Class gret))]
         _ (&type/check exo-type (as-otype+ output-type))
         _cursor &/cursor]
     (return (&/|list (&&/|meta exo-type _cursor
-                               (&/V &&/$jvm-invokestatic (&/T class method classes =args output-type)))))))
+                               (&/V &&/$jvm-invokestatic (&/T gc-name method arg-classes =args output-type)))))))
 
 (defn analyse-jvm-null? [analyse exo-type object]
   (|do [=object (&&/analyse-1+ analyse object)
@@ -344,31 +332,32 @@
     (return (&/|list (&&/|meta output-type _cursor
                                (&/V &&/$jvm-null nil))))))
 
-(defn ^:private analyse-jvm-new-helper [analyse gtype gtype-env gtype-vars gtype-args args]
+(defn ^:private analyse-jvm-new-helper [analyse gc-name gc-params gtype-env gtype-vars gtype-args args]
+  (prn 'analyse-jvm-new-helper gc-name (&/->seq gc-params) (&/->seq (&/|map #(.getName ^TypeVariable %) gtype-vars)))
   (|case gtype-vars
     (&/$Nil)
     (|do [arg-types (&/map% (partial &host-type/instance-param &type/existential gtype-env) gtype-args)
           =args (&/map2% (partial &&/analyse-1 analyse) arg-types args)
-          gtype-vars* (->> gtype-env (&/|map &/|second) (clean-gtype-vars))]
-      (return (&/T (make-gtype gtype gtype-vars*)
+          :let [gtype-vars* (->> gtype-env (&/|map &/|second))]]
+      (return (&/T (make-gtype gc-name gtype-vars*)
                    =args)))
     
     (&/$Cons ^TypeVariable gtv gtype-vars*)
-    (&type/with-var
-      (fn [$var]
-        (|let [gtype-env* (&/Cons$ (&/T (.getName gtv) $var) gtype-env)]
-          (analyse-jvm-new-helper analyse gtype gtype-env* gtype-vars* gtype-args args))))
+    (|let [gtype-env* (&/Cons$ (&/T (.getName gtv) (->> gc-params &/|head instance-generic-type))
+                               gtype-env)]
+      (analyse-jvm-new-helper analyse gc-name (&/|tail gc-params) gtype-env* gtype-vars* gtype-args args))
     ))
 
-(defn analyse-jvm-new [analyse exo-type class classes args]
+(defn analyse-jvm-new [analyse exo-type generic-class arg-classes args]
   (|do [class-loader &/loader
-        [exceptions gvars gargs] (&host/lookup-constructor class-loader class classes)
+        :let [[gc-name gc-params] generic-class]
+        [exceptions gvars gargs] (&host/lookup-constructor class-loader gc-name arg-classes)
         _ (ensure-catching exceptions)
-        [output-type =args] (analyse-jvm-new-helper analyse class (&/|table) gvars gargs args)
+        [output-type =args] (analyse-jvm-new-helper analyse gc-name gc-params (&/|table) gvars gargs args)
         _ (&type/check exo-type output-type)
         _cursor &/cursor]
     (return (&/|list (&&/|meta exo-type _cursor
-                               (&/V &&/$jvm-new (&/T class classes =args)))))))
+                               (&/V &&/$jvm-new (&/T gc-name arg-classes =args)))))))
 
 (let [length-type &type/Int
       idx-type &type/Int]