- Added support for defining static methods in JVM classes.

- Fixed a bug wherein host data-types weren't getting cleaned when working with type variables.

7 files changed, 103 insertions, 12 deletions

diff --git a/src/lux/analyser/base.clj b/src/lux/analyser/base.clj
index 5149456aa..318149b9f 100644
--- a/src/lux/analyser/base.clj
+++ b/src/lux/analyser/base.clj
@@ -152,10 +152,19 @@
    "jvm-lushr"])
 
 ;; [Exports]
-(defn expr-type* [syntax+]
-  (|let [[[type _] _] syntax+]
+(defn expr-type* [analysis]
+  (|let [[[type _] _] analysis]
     type))
 
+(defn with-type [new-type analysis]
+  (|let [[[type cursor] adt] analysis]
+    (&/T [(&/T [new-type cursor]) adt])))
+
+(defn clean-analysis [$var an]
+  "(-> Type Analysis (Lux Analysis))"
+  (|do [=an-type (&type/clean $var (expr-type* an))]
+    (return (with-type =an-type an))))
+
 (def jvm-this "_jvm_this")
 
 (defn cap-1 [action]
diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index bce75bea7..a467e7822 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -268,6 +268,7 @@
   (|case gtype-vars
     (&/$Nil)
     (|do [arg-types (&/map% (partial &host-type/instance-param &type/existential gtype-env) gtype-args)
+          =arg-types (&/map% &type/show-type+ arg-types)
           =args (&/map2% (partial &&/analyse-1 analyse) arg-types args)
           =gret (&host-type/instance-param &type/existential gtype-env gret)]
       (return (&/T [=gret =args])))
@@ -275,8 +276,11 @@
     (&/$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))))
+        (|do [:let [gtype-env* (&/Cons$ (&/T [(.getName gtv) $var]) gtype-env)]
+              [=gret =args] (analyse-method-call-helper analyse gret gtype-env* gtype-vars* gtype-args args)
+              ==gret (&type/clean $var =gret)
+              ==args (&/map% (partial &&/clean-analysis $var) =args)]
+          (return (&/T [==gret ==args])))))
     ))
 
 (let [dummy-type-param (&type/Data$ "java.lang.Object" (&/|list))]
@@ -316,11 +320,7 @@
   (|do [class-loader &/loader
         [gret exceptions parent-gvars gvars gargs] (&host/lookup-static-method class-loader class method classes)
         _ (ensure-catching exceptions)
-        gtype-env (&/fold% (fn [m ^TypeVariable g]
-                             (|do [=var-type &type/existential]
-                               (return (&/Cons$ (&/T [(.getName g) =var-type]) m))))
-                           (&/|table)
-                           parent-gvars)
+        :let [gtype-env (&/|table)]
         [output-type =args] (analyse-method-call-helper analyse gret gtype-env gvars gargs args)
         _ (&type/check exo-type (as-otype+ output-type))
         _cursor &/cursor]
@@ -622,6 +622,23 @@
                               (&&/analyse-1 analyse output-type ?body)
                               (&/|reverse ?inputs))))]
         (return (&/V &/$OverridenMethodAnalysis (&/T [?class-decl ?name ?anns ?gvars ?exceptions ?inputs ?output =body]))))
+
+      (&/$StaticMethodSyntax ?name =privacy-modifier ?anns ?gvars ?exceptions ?inputs ?output ?body)
+      (|do [method-env (&/map% (fn [gvar]
+                                 (|do [ex &type/existential]
+                                   (return (&/T [gvar ex]))))
+                               ?gvars)
+            :let [full-env method-env]
+            output-type (generic-class->type full-env ?output)
+            =body (&/with-type-env full-env
+                    (&/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 &/$StaticMethodAnalysis (&/T [?name =privacy-modifier ?anns ?gvars ?exceptions ?inputs ?output =body]))))
       )))
 
 (defn ^:private mandatory-methods [supers]
@@ -641,6 +658,9 @@
                                       
                                       (&/$OverridenMethodAnalysis =class-decl =name =anns =gvars =exceptions =inputs =output body)
                                       (assoc mmap =name =inputs)
+
+                                      (&/$StaticMethodAnalysis _)
+                                      mmap
                                       ))
                                   {}
                                   methods)
diff --git a/src/lux/analyser/parser.clj b/src/lux/analyser/parser.clj
index 3c4d4413d..26b161aba 100644
--- a/src/lux/analyser/parser.clj
+++ b/src/lux/analyser/parser.clj
@@ -229,10 +229,33 @@
     _
     (fail "")))
 
+(defn ^:private parse-method-static-def [ast]
+  (|case ast
+    [_ (&/$FormS (&/$Cons [_ (&/$TextS "static")]
+                          (&/$Cons [_ (&/$TextS ?name)]
+                                   (&/$Cons ?privacy-modifier
+                                            (&/$Cons [_ (&/$TupleS anns)]
+                                                     (&/$Cons [_ (&/$TupleS gvars)]
+                                                              (&/$Cons [_ (&/$TupleS exceptions)]
+                                                                       (&/$Cons [_ (&/$TupleS inputs)]
+                                                                                (&/$Cons output
+                                                                                         (&/$Cons body (&/$Nil)))))))))))]
+    (|do [=privacy-modifier (parse-privacy-modifier ?privacy-modifier)
+          =anns (&/map% parse-ann anns)
+          =gvars (&/map% parse-text gvars)
+          =exceptions (&/map% parse-gclass exceptions)
+          =inputs (&/map% parse-arg-decl inputs)
+          =output (parse-gclass output)]
+      (return (&/V &/$StaticMethodSyntax (&/T [?name =privacy-modifier =anns =gvars =exceptions =inputs =output body]))))
+
+    _
+    (fail "")))
+
 (defn parse-method-def [ast]
   (&/try-all% (&/|list #((parse-method-init-def ast) %)
                        #((parse-method-virtual-def ast) %)
                        #((parse-method-override-def ast) %)
+                       #((parse-method-static-def ast) %)
                        (fn [state]
                          (fail* (str "[Analyser Error] Invalid method definition: " (&/show-ast ast)))))))
 
diff --git a/src/lux/base.clj b/src/lux/base.clj
index 9bfd60350..dc8dc0081 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -120,12 +120,14 @@
 (deftags
   ["ConstructorMethodSyntax"
    "VirtualMethodSyntax"
-   "OverridenMethodSyntax"])
+   "OverridenMethodSyntax"
+   "StaticMethodSyntax"])
 
 (deftags
   ["ConstructorMethodAnalysis"
    "VirtualMethodAnalysis"
-   "OverridenMethodAnalysis"])
+   "OverridenMethodAnalysis"
+   "StaticMethodAnalysis"])
 
 ;; Meta-data
 (deftags
diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj
index 291d78ee2..deeb529b5 100644
--- a/src/lux/compiler/host.clj
+++ b/src/lux/compiler/host.clj
@@ -570,6 +570,26 @@
                         (.visitMaxs 0 0)
                         (.visitEnd))]]
           (return nil))))
+
+    (&/$StaticMethodAnalysis ?name ?privacy-modifier ?anns ?gvars ?exceptions ?inputs ?output ?body)
+    (|let [=method-decl (&/T [?name ?anns ?gvars ?exceptions (&/|map &/|second ?inputs) ?output])
+           [simple-signature generic-signature] (&host-generics/method-signatures =method-decl)]
+      (&/with-writer (.visitMethod class-writer
+                                   (+ (privacy-modifer->flag ?privacy-modifier)
+                                      Opcodes/ACC_STATIC)
+                                   ?name
+                                   simple-signature
+                                   generic-signature
+                                   (->> ?exceptions (&/|map &host-generics/->bytecode-class-name) &/->seq (into-array java.lang.String)))
+        (|do [^MethodVisitor =method &/get-writer
+              :let [_ (&/|map (partial compile-annotation =method) ?anns)
+                    _ (.visitCode =method)]
+              _ (compile ?body)
+              :let [_ (doto =method
+                        (compile-method-return ?output)
+                        (.visitMaxs 0 0)
+                        (.visitEnd))]]
+          (return nil))))
     ))
 
 (defn ^:private compile-method-decl [^ClassWriter class-writer =method-decl]
diff --git a/src/lux/host.clj b/src/lux/host.clj
index 36375ae0f..fe648c8ff 100644
--- a/src/lux/host.clj
+++ b/src/lux/host.clj
@@ -313,6 +313,19 @@
         (.visitMaxs 0 0)
         (.visitEnd)))
 
+    (&/$StaticMethodSyntax =name =privacy-modifier =anns =gvars =exceptions =inputs =output body)
+    (|let [method-decl [=name =anns =gvars =exceptions (&/|map &/|second =inputs) =output]
+           [simple-signature generic-signature] (&host-generics/method-signatures method-decl)]
+      (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC)
+                          =name
+                          simple-signature
+                          generic-signature
+                          (->> =exceptions (&/|map &host-generics/gclass->bytecode-class-name) &/->seq (into-array java.lang.String)))
+        .visitCode
+        (dummy-return =output)
+        (.visitMaxs 0 0)
+        (.visitEnd)))
+
     _
     (assert false (println-str 'compile-dummy-method (&/adt->text method-def)))
     ))
diff --git a/src/lux/type.clj b/src/lux/type.clj
index 936fe9409..d3a5f1493 100644
--- a/src/lux/type.clj
+++ b/src/lux/type.clj
@@ -279,6 +279,10 @@
           (deref ?id)
           (return type)))
       (return type))
+
+    (&/$DataT ?name ?params)
+    (|do [=params (&/map% (partial clean* ?tid) ?params)]
+      (return (Data$ ?name =params)))
     
     (&/$LambdaT ?arg ?return)
     (|do [=arg (clean* ?tid ?arg)
@@ -503,7 +507,7 @@
 (defn ^:private fp-put [k v fixpoints]
   (&/Cons$ (&/T [k v]) fixpoints))
 
-(defn ^:private show-type+ [type]
+(defn show-type+ [type]
   (|case type
     (&/$VarT ?id)
     (fn [state]