- Fixed some errors with JVM interop.

3 files changed, 128 insertions, 100 deletions

diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index bd0957bdf..e1c167ce6 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -43,6 +43,14 @@
     _
     (fail (str "[Analyser Error] Not a tag: " (&/show-ast ast)))))
 
+(defn ^:private extract-text [ast]
+  (|case ast
+    [_ (&/$TextS text)]
+    (return text)
+
+    _
+    (fail (str "[Analyser Error] Can't extract text: " (&/show-ast ast)))))
+
 (defn analyse-variant+ [analyser exo-type ident values]
   (|do [[module tag-name] (&/normalize ident)
         idx (&&module/tag-index module tag-name)]
@@ -155,13 +163,15 @@
                                                   (&/$Cons [_ (&/$TupleS ?fields)]
                                                            (&/$Cons [_ (&/$TupleS ?methods)]
                                                                     (&/$Nil))))))))
-    (&&host/analyse-jvm-class analyse compile-token ?name ?super-class ?interfaces ?fields ?methods)
+    (|do [=interfaces (&/map% extract-text ?interfaces)]
+      (&&host/analyse-jvm-class analyse compile-token ?name ?super-class =interfaces ?fields ?methods))
 
     (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_interface")]
                        (&/$Cons [_ (&/$TextS ?name)]
                                 (&/$Cons [_ (&/$TupleS ?supers)]
                                          ?methods))))
-    (&&host/analyse-jvm-interface analyse compile-token ?name ?supers ?methods)
+    (|do [=supers (&/map% extract-text ?supers)]
+      (&&host/analyse-jvm-interface analyse compile-token ?name =supers ?methods))
 
     ;; Programs
     (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_program")]
@@ -280,7 +290,8 @@
                                 (&/$Cons [_ (&/$TupleS ?classes)]
                                          (&/$Cons [_ (&/$TupleS ?args)]
                                                   (&/$Nil))))))
-    (&&host/analyse-jvm-new analyse exo-type ?class ?classes ?args)
+    (|do [=classes (&/map% extract-text ?classes)]
+      (&&host/analyse-jvm-new analyse exo-type ?class =classes ?args))
 
     (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_getstatic")]
                        (&/$Cons [_ (&/$TextS ?class)]
@@ -316,7 +327,8 @@
                                          (&/$Cons [_ (&/$TupleS ?classes)]
                                                   (&/$Cons [_ (&/$TupleS ?args)]
                                                            (&/$Nil)))))))
-    (&&host/analyse-jvm-invokestatic analyse exo-type ?class ?method ?classes ?args)
+    (|do [=classes (&/map% extract-text ?classes)]
+      (&&host/analyse-jvm-invokestatic analyse exo-type ?class ?method =classes ?args))
 
     (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_invokevirtual")]
                        (&/$Cons [_ (&/$TextS ?class)]
@@ -325,7 +337,8 @@
                                                   (&/$Cons ?object
                                                            (&/$Cons [_ (&/$TupleS ?args)]
                                                                     (&/$Nil))))))))
-    (&&host/analyse-jvm-invokevirtual analyse exo-type ?class ?method ?classes ?object ?args)
+    (|do [=classes (&/map% extract-text ?classes)]
+      (&&host/analyse-jvm-invokevirtual analyse exo-type ?class ?method =classes ?object ?args))
 
     (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_invokeinterface")]
                        (&/$Cons [_ (&/$TextS ?class)]
@@ -334,7 +347,8 @@
                                                   (&/$Cons ?object
                                                            (&/$Cons [_ (&/$TupleS ?args)]
                                                                     (&/$Nil))))))))
-    (&&host/analyse-jvm-invokeinterface analyse exo-type ?class ?method ?classes ?object ?args)
+    (|do [=classes (&/map% extract-text ?classes)]
+      (&&host/analyse-jvm-invokeinterface analyse exo-type ?class ?method =classes ?object ?args))
 
     (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_invokespecial")]
                        (&/$Cons [_ (&/$TextS ?class)]
@@ -343,7 +357,8 @@
                                                   (&/$Cons ?object
                                                            (&/$Cons [_ (&/$TupleS ?args)]
                                                                     (&/$Nil))))))))
-    (&&host/analyse-jvm-invokespecial analyse exo-type ?class ?method ?classes ?object ?args)
+    (|do [=classes (&/map% extract-text ?classes)]
+      (&&host/analyse-jvm-invokespecial analyse exo-type ?class ?method =classes ?object ?args))
 
     ;; Exceptions
     (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_try")]
diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index 4fbd67fdb..69e1ff47a 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -15,21 +15,21 @@
                           [env :as &&env])))
 
 ;; [Utils]
-(defn ^:private extract-text [text]
-  (|case text
-    [_ (&/$TextS ?text)]
-    (return ?text)
+(defn ^:private extract-text [ast]
+  (|case ast
+    [_ (&/$TextS text)]
+    (return text)
 
     _
-    (fail "[Analyser Error] Can't extract Text.")))
+    (fail "[Analyser/Host Error] Can't extract text.")))
 
-(defn ^:private analyse-1+ [analyse ?token]
+(defn ^:private analyse-1+ [analyse token]
   (&type/with-var
     (fn [$var]
-      (|do [=expr (&&/analyse-1 analyse $var ?token)
-            :let [[?item ?type] =expr]
-            =type (&type/clean $var ?type)]
-        (return (&/T ?item =type))))))
+      (|do [=expr (&&/analyse-1 analyse $var token)
+            :let [[item type] =expr]
+            =type (&type/clean $var type)]
+        (return (&/T item =type))))))
 
 (defn ^:private ensure-object [token]
   "(-> Analysis (Lux (,)))"
@@ -76,9 +76,9 @@
 (do-template [<name> <output-tag> <input-class> <output-class>]
   (let [input-type (&type/Data$ <input-class> (&/|list))
         output-type (&type/Data$ <output-class> (&/|list))]
-    (defn <name> [analyse exo-type ?x ?y]
-      (|do [=x (&&/analyse-1 analyse input-type ?x)
-            =y (&&/analyse-1 analyse input-type ?y)
+    (defn <name> [analyse exo-type x y]
+      (|do [=x (&&/analyse-1 analyse input-type x)
+            =y (&&/analyse-1 analyse input-type y)
             _ (&type/check exo-type output-type)]
         (return (&/|list (&/T (&/V <output-tag> (&/T =x =y)) output-type))))))
 
@@ -123,92 +123,89 @@
   analyse-jvm-dgt  &&/$jvm-dgt  "java.lang.Double"  "java.lang.Boolean"
   )
 
-(defn analyse-jvm-getstatic [analyse exo-type ?class ?field]
+(defn analyse-jvm-getstatic [analyse exo-type class field]
   (|do [class-loader &/loader
-        =type (&host/lookup-static-field class-loader ?class ?field)
+        =type (&host/lookup-static-field class-loader class field)
         :let [output-type =type]
         _ (&type/check exo-type output-type)]
-    (return (&/|list (&/T (&/V &&/$jvm-getstatic (&/T ?class ?field)) output-type)))))
+    (return (&/|list (&/T (&/V &&/$jvm-getstatic (&/T class field)) output-type)))))
 
-(defn analyse-jvm-getfield [analyse exo-type ?class ?field ?object]
+(defn analyse-jvm-getfield [analyse exo-type class field object]
   (|do [class-loader &/loader
-        =type (&host/lookup-static-field class-loader ?class ?field)
-        =object (&&/analyse-1 analyse ?object)
+        =type (&host/lookup-static-field class-loader class field)
+        =object (&&/analyse-1 analyse object)
         :let [output-type =type]
         _ (&type/check exo-type output-type)]
-    (return (&/|list (&/T (&/V &&/$jvm-getfield (&/T ?class ?field =object)) output-type)))))
+    (return (&/|list (&/T (&/V &&/$jvm-getfield (&/T class field =object)) output-type)))))
 
-(defn analyse-jvm-putstatic [analyse exo-type ?class ?field ?value]
+(defn analyse-jvm-putstatic [analyse exo-type class field value]
   (|do [class-loader &/loader
-        =type (&host/lookup-static-field class-loader ?class ?field)
-        =value (&&/analyse-1 analyse =type ?value)
+        =type (&host/lookup-static-field class-loader class field)
+        =value (&&/analyse-1 analyse =type value)
         :let [output-type &type/Unit]
         _ (&type/check exo-type output-type)]
-    (return (&/|list (&/T (&/V &&/$jvm-putstatic (&/T ?class ?field =value)) output-type)))))
+    (return (&/|list (&/T (&/V &&/$jvm-putstatic (&/T class field =value)) output-type)))))
 
-(defn analyse-jvm-putfield [analyse exo-type ?class ?field ?object ?value]
+(defn analyse-jvm-putfield [analyse exo-type class field object value]
   (|do [class-loader &/loader
-        =type (&host/lookup-static-field class-loader ?class ?field)
-        =object (&&/analyse-1 analyse ?object)
-        =value (&&/analyse-1 analyse =type ?value)
+        =type (&host/lookup-static-field class-loader class field)
+        =object (&&/analyse-1 analyse object)
+        =value (&&/analyse-1 analyse =type value)
         :let [output-type &type/Unit]
         _ (&type/check exo-type output-type)]
-    (return (&/|list (&/T (&/V &&/$jvm-putfield (&/T ?class ?field =object =value)) output-type)))))
+    (return (&/|list (&/T (&/V &&/$jvm-putfield (&/T class field =object =value)) output-type)))))
 
-(defn analyse-jvm-invokestatic [analyse exo-type ?class ?method ?classes ?args]
+(defn analyse-jvm-invokestatic [analyse exo-type class method classes args]
   (|do [class-loader &/loader
-        =classes (&/map% extract-text ?classes)
-        =return (&host/lookup-static-method class-loader ?class ?method =classes)
+        =return (&host/lookup-static-method class-loader class method classes)
         ;; :let [_ (matchv ::M/objects [=return]
         ;;           [[&/$DataT _return-class (&/|list)]]
-        ;;           (prn 'analyse-jvm-invokestatic ?class ?method _return-class))]
+        ;;           (prn 'analyse-jvm-invokestatic class method _return-class))]
         =args (&/map2% (fn [_class _arg]
                          (&&/analyse-1 analyse (&type/Data$ _class (&/|list)) _arg))
-                       =classes
-                       ?args)
+                       classes
+                       args)
         :let [output-type =return]
         _ (&type/check exo-type (as-otype+ output-type))]
-    (return (&/|list (&/T (&/V &&/$jvm-invokestatic (&/T ?class ?method =classes =args)) output-type)))))
+    (return (&/|list (&/T (&/V &&/$jvm-invokestatic (&/T class method classes =args)) output-type)))))
 
-(defn analyse-jvm-instanceof [analyse exo-type ?class ?object]
-  (|do [=object (analyse-1+ analyse ?object)
+(defn analyse-jvm-instanceof [analyse exo-type class object]
+  (|do [=object (analyse-1+ analyse object)
         _ (ensure-object =object)
         :let [output-type &type/Bool]
         _ (&type/check exo-type output-type)]
-    (return (&/|list (&/T (&/V &&/$jvm-instanceof (&/T ?class =object)) output-type)))))
+    (return (&/|list (&/T (&/V &&/$jvm-instanceof (&/T class =object)) output-type)))))
 
 (do-template [<name> <tag>]
-  (defn <name> [analyse exo-type ?class ?method ?classes ?object ?args]
+  (defn <name> [analyse exo-type class method classes object args]
     (|do [class-loader &/loader
-          =classes (&/map% extract-text ?classes)
-          =return (&host/lookup-virtual-method class-loader ?class ?method =classes)
-          =object (&&/analyse-1 analyse (&type/Data$ ?class (&/|list)) ?object)
-          =args (&/map2% (fn [?c ?o] (&&/analyse-1 analyse (&type/Data$ ?c (&/|list)) ?o))
-                         =classes ?args)
+          =return (&host/lookup-virtual-method class-loader class method classes)
+          =object (&&/analyse-1 analyse (&type/Data$ class (&/|list)) object)
+          =args (&/map2% (fn [c o] (&&/analyse-1 analyse (&type/Data$ c (&/|list)) o))
+                         classes args)
           :let [output-type =return]
           _ (&type/check exo-type (as-otype+ output-type))]
-      (return (&/|list (&/T (&/V <tag> (&/T ?class ?method =classes =object =args)) output-type)))))
+      (return (&/|list (&/T (&/V <tag> (&/T class method classes =object =args)) output-type)))))
 
   analyse-jvm-invokevirtual   &&/$jvm-invokevirtual
   analyse-jvm-invokeinterface &&/$jvm-invokeinterface
   )
 
-(defn analyse-jvm-invokespecial [analyse exo-type ?class ?method ?classes ?object ?args]
+(defn analyse-jvm-invokespecial [analyse exo-type class method classes object args]
   (|do [class-loader &/loader
-        =classes (&/map% extract-text ?classes)
-        =return (if (= "<init>" ?method)
+        =return (if (= "<init>" method)
                   (return &type/Unit)
-                  (&host/lookup-virtual-method class-loader ?class ?method =classes))
-        =object (&&/analyse-1 analyse (&type/Data$ ?class (&/|list)) ?object)
-        =args (&/map2% (fn [?c ?o]
-                         (&&/analyse-1 analyse (&type/Data$ ?c (&/|list)) ?o))
-                       =classes ?args)
+                  (&host/lookup-virtual-method class-loader class method classes))
+        =object (&&/analyse-1 analyse (&type/Data$ class (&/|list)) object)
+        =args (&/map2% (fn [c o]
+                         (&&/analyse-1 analyse (&type/Data$ c (&/|list)) o))
+                       classes args)
         :let [output-type =return]
         _ (&type/check exo-type (as-otype+ output-type))]
-    (return (&/|list (&/T (&/V &&/$jvm-invokespecial (&/T ?class ?method =classes =object =args)) output-type)))))
+    (return (&/|list (&/T (&/V &&/$jvm-invokespecial (&/T class method classes =object =args)) output-type)))))
 
-(defn analyse-jvm-null? [analyse exo-type ?object]
-  (|do [=object (analyse-1+ analyse ?object)
+(defn analyse-jvm-null? [analyse exo-type object]
+  (|do [=object (analyse-1+ analyse object)
         _ (ensure-object =object)
         :let [output-type &type/Bool]
         _ (&type/check exo-type output-type)]
@@ -219,12 +216,14 @@
         _ (&type/check exo-type output-type)]
     (return (&/|list (&/T (&/V &&/$jvm-null nil) output-type)))))
 
-(defn analyse-jvm-new [analyse exo-type ?class ?classes ?args]
-  (|do [=classes (&/map% extract-text ?classes)
-        =args (&/map% (partial analyse-1+ analyse) ?args)
-        :let [output-type (&type/Data$ ?class (&/|list))]
+(defn analyse-jvm-new [analyse exo-type class classes args]
+  (|do [class-loader &/loader
+        =return (&host/lookup-constructor class-loader class classes)
+        =args (&/map2% (fn [c o] (&&/analyse-1 analyse (&type/Data$ c (&/|list)) o))
+                       classes args)
+        :let [output-type (&type/Data$ class (&/|list))]
         _ (&type/check exo-type output-type)]
-    (return (&/|list (&/T (&/V &&/$jvm-new (&/T ?class =classes =args)) output-type)))))
+    (return (&/|list (&/T (&/V &&/$jvm-new (&/T class classes =args)) output-type)))))
 
 (do-template [<class> <new-name> <new-tag> <load-name> <load-tag> <store-name> <store-tag>]
   (let [elem-type (&type/Data$ <class> (&/|list))
@@ -316,8 +315,7 @@
            modifiers))
 
 (defn analyse-jvm-class [analyse compile-token ?name ?super-class ?interfaces ?fields ?methods]
-  (|do [=interfaces (&/map% extract-text ?interfaces)
-        =fields (&/map% (fn [?field]
+  (|do [=fields (&/map% (fn [?field]
                           (|case ?field
                             [_ (&/$FormS (&/$Cons [_ (&/$TextS ?field-name)]
                                                   (&/$Cons [_ (&/$TextS ?field-type)]
@@ -360,7 +358,7 @@
                                                             (&&/analyse-1 analyse (&type/Data$ (as-otype ?method-output) (&/|list)) ?method-body))
                                                           (&/|reverse (if (:static? =method-modifiers)
                                                                         =method-inputs
-                                                                        (&/Cons$ (&/T ";this" ?super-class)
+                                                                        (&/Cons$ (&/T "this" ?super-class)
                                                                                  =method-inputs)))))]
                                (return {:name ?method-name
                                         :modifiers =method-modifiers
@@ -371,29 +369,29 @@
                              _
                              (fail "[Analyser Error] Wrong syntax for method.")))
                          (&/enumerate ?methods))
-        _ (compile-token (&/V &&/$jvm-class (&/T ?name ?super-class =interfaces =fields =methods)))]
+        _ (compile-token (&/V &&/$jvm-class (&/T ?name ?super-class ?interfaces =fields =methods)))
+        :let [_ (prn 'analyse-jvm-class ?name ?super-class)]]
     (return (&/|list))))
 
-(defn analyse-jvm-interface [analyse compile-token ?name ?supers ?methods]
-  (|do [=supers (&/map% extract-text ?supers)
-        =methods (&/map% (fn [method]
+(defn analyse-jvm-interface [analyse compile-token name supers methods]
+  (|do [=methods (&/map% (fn [method]
                            (|case method
-                             [_ (&/$FormS (&/$Cons [_ (&/$TextS ?method-name)]
-                                                   (&/$Cons [_ (&/$TupleS ?inputs)]
-                                                            (&/$Cons [_ (&/$TextS ?output)]
-                                                                     (&/$Cons [_ (&/$TupleS ?modifiers)]
+                             [_ (&/$FormS (&/$Cons [_ (&/$TextS method-name)]
+                                                   (&/$Cons [_ (&/$TupleS inputs)]
+                                                            (&/$Cons [_ (&/$TextS output)]
+                                                                     (&/$Cons [_ (&/$TupleS modifiers)]
                                                                               (&/$Nil))))))]
-                             (|do [=inputs (&/map% extract-text ?inputs)
-                                   =modifiers (analyse-modifiers ?modifiers)]
-                               (return {:name ?method-name
+                             (|do [=inputs (&/map% extract-text inputs)
+                                   =modifiers (analyse-modifiers modifiers)]
+                               (return {:name method-name
                                         :modifiers =modifiers
                                         :inputs =inputs
-                                        :output ?output}))
+                                        :output output}))
                              
                              _
                              (fail (str "[Analyser Error] Invalid method signature: " (&/show-ast method)))))
-                         ?methods)
-        _ (compile-token (&/V &&/$jvm-interface (&/T ?name =supers =methods)))]
+                         methods)
+        _ (compile-token (&/V &&/$jvm-interface (&/T name supers =methods)))]
     (return (&/|list))))
 
 (defn analyse-jvm-try [analyse exo-type ?body ?catches+?finally]
diff --git a/src/lux/host.clj b/src/lux/host.clj
index 0936d90eb..81323b1d8 100644
--- a/src/lux/host.clj
+++ b/src/lux/host.clj
@@ -10,7 +10,7 @@
             clojure.core.match.array
             (lux [base :as & :refer [|do return* return fail fail* |let |case]]
                  [type :as &type]))
-  (:import (java.lang.reflect Field Method Modifier)
+  (:import (java.lang.reflect Field Method Constructor Modifier)
            java.util.regex.Pattern))
 
 ;; [Constants]
@@ -22,19 +22,21 @@
 
 ;; [Utils]
 (defn ^:private class->type [^Class class]
+  "(-> Class Type)"
   (if-let [[_ base arr-level] (re-find #"^([^\[]+)(\[\])*$"
                                        (str (if-let [pkg (.getPackage class)]
                                               (str (.getName pkg) ".")
                                               "")
                                             (.getSimpleName class)))]
     (if (.equals "void" base)
-      (return &type/Unit)
-      (return (&type/Data$ (str (reduce str "" (repeat (int (/ (count arr-level) 2)) "["))
-                                base)
-                           (&/|list)))
+      &type/Unit
+      (&type/Data$ (str (reduce str "" (repeat (int (/ (count arr-level) 2)) "["))
+                        base)
+                   (&/|list))
       )))
 
 (defn ^:private method->type [^Method method]
+  "(-> Method Type)"
   (class->type (.getReturnType method)))
 
 ;; [Resources]
@@ -93,9 +95,8 @@
                                 :when (and (.equals ^Object field (.getName =field))
                                            (.equals ^Object <static?> (Modifier/isStatic (.getModifiers =field))))]
                             (.getType =field)))]
-      (|do [=type (class->type type*)]
-        (return =type))
-      (fail (str "[Analyser Error] Field does not exist: " target "." field))))
+      (return (class->type type*))
+      (fail (str "[Host Error] Field does not exist: " target "." field))))
 
   lookup-static-field true
   lookup-field        false
@@ -107,17 +108,31 @@
     (if-let [method (first (for [^Method =method (.getDeclaredMethods (Class/forName (&type/as-obj target) true class-loader))
                                  :when (and (.equals ^Object method-name (.getName =method))
                                             (.equals ^Object <static?> (Modifier/isStatic (.getModifiers =method)))
-                                            (&/fold2 #(and %1 (.equals ^Object %2 %3))
-                                                     true
-                                                     args
-                                                     (&/|map #(.getName ^Class %) (&/->list (seq (.getParameterTypes =method))))))]
+                                            (let [param-types (&/->list (seq (.getParameterTypes =method)))]
+                                              (and (= (&/|length args) (&/|length param-types))
+                                                   (&/fold2 #(and %1 (.equals ^Object %2 %3))
+                                                            true
+                                                            args
+                                                            (&/|map #(.getName ^Class %) param-types)))))]
                              =method))]
-      (method->type method)
-      (fail (str "[Analyser Error] Method does not exist: " target "." method-name))))
+      (return (method->type method))
+      (fail (str "[Host Error] Method does not exist: " target "." method-name))))
 
   lookup-static-method  true
   lookup-virtual-method false
   )
 
+(defn lookup-constructor [class-loader target args]
+  (if-let [ctor (first (for [^Constructor =method (.getDeclaredConstructors (Class/forName (&type/as-obj target) true class-loader))
+                             :when (let [param-types (&/->list (seq (.getParameterTypes =method)))]
+                                     (and (= (&/|length args) (&/|length param-types))
+                                          (&/fold2 #(and %1 (.equals ^Object %2 %3))
+                                                   true
+                                                   args
+                                                   (&/|map #(.getName ^Class %) param-types))))]
+                         =method))]
+    (return &type/Unit)
+    (fail (str "[Host Error] Constructor does not exist: " target))))
+
 (defn location [scope]
   (->> scope (&/|map &/normalize-name) (&/|interpose "$") (&/fold str "")))