Now testing the methods implemented in anonymous classes to make sure all abstract methods are implemented, and no new methods (that is to say, non-overriden methods) are introduced.

8 files changed, 207 insertions, 48 deletions

diff --git a/luxc/src/lux/host.clj b/luxc/src/lux/host.clj
index 5b93f5b49..562d582f6 100644
--- a/luxc/src/lux/host.clj
+++ b/luxc/src/lux/host.clj
@@ -27,8 +27,9 @@
 
 (def ->package ->module-class)
 
-(defn unfold-array [type]
+(defn unfold-array
   "(-> Type (, Int Type))"
+  [type]
   (|case type
     (&/$Primitive "#Array" (&/$Cons param (&/$Nil)))
     (|let [[count inner] (unfold-array param)]
@@ -39,8 +40,9 @@
 
 (let [ex-type-class (str "L" (&host-generics/->bytecode-class-name "java.lang.Object") ";")
       object-array (str "[" "L" (&host-generics/->bytecode-class-name "java.lang.Object") ";")]
-  (defn ->java-sig [^objects type]
+  (defn ->java-sig
     "(-> Type (Lux Text))"
+    [^objects type]
     (|case type
       (&/$Primitive ?name params)
       (cond (= &host-type/array-data-tag ?name) (|do [:let [[level base] (unfold-array type)]
@@ -145,8 +147,9 @@
         (return (&/T [exs gvars gargs])))
       (&/fail-with-loc (str "[Host Error] Constructor does not exist: " target " " (->> args &/->seq print-str))))))
 
-(defn abstract-methods [class-loader super-class]
+(defn abstract-methods
   "(-> ClassLoader SuperClassDecl (Lux (List (, Text (List Text)))))"
+  [class-loader super-class]
   (|let [[super-name super-params] super-class]
     (return (&/->list (for [^Method =method (.getDeclaredMethods (Class/forName super-name true class-loader))
                             :when (Modifier/isAbstract (.getModifiers =method))]
@@ -362,8 +365,9 @@
     (assert false (println-str 'compile-dummy-method (&/adt->text method-def)))
     ))
 
-(defn privacy-modifier->flag [privacy-modifier]
+(defn privacy-modifier->flag
   "(-> PrivacyModifier Int)"
+  [privacy-modifier]
   (|case privacy-modifier
     (&/$PublicPM)    Opcodes/ACC_PUBLIC
     (&/$PrivatePM)   Opcodes/ACC_PRIVATE
@@ -371,15 +375,17 @@
     (&/$DefaultPM)   0
     ))
 
-(defn state-modifier->flag [state-modifier]
+(defn state-modifier->flag
   "(-> StateModifier Int)"
+  [state-modifier]
   (|case state-modifier
     (&/$DefaultSM)  0
     (&/$VolatileSM) Opcodes/ACC_VOLATILE
     (&/$FinalSM)    Opcodes/ACC_FINAL))
 
-(defn inheritance-modifier->flag [inheritance-modifier]
+(defn inheritance-modifier->flag
   "(-> InheritanceModifier Int)"
+  [inheritance-modifier]
   (|case inheritance-modifier
     (&/$DefaultIM)  0
     (&/$AbstractIM) Opcodes/ACC_ABSTRACT
diff --git a/stdlib/source/lux/data/collection/list.lux b/stdlib/source/lux/data/collection/list.lux
index ff6739076..f03b2bf2e 100644
--- a/stdlib/source/lux/data/collection/list.lux
+++ b/stdlib/source/lux/data/collection/list.lux
@@ -356,8 +356,8 @@
 (def: #export (empty? xs)
   (All [a] (Predicate (List a)))
   (case xs
-    #.Nil #1
-    _     #0))
+    #.Nil true
+    _     false))
 
 (def: #export (member? eq xs x)
   (All [a] (-> (Equivalence a) (List a) a Bit))
diff --git a/stdlib/source/lux/data/product.lux b/stdlib/source/lux/data/product.lux
index bb3191e24..64b84cb3e 100644
--- a/stdlib/source/lux/data/product.lux
+++ b/stdlib/source/lux/data/product.lux
@@ -1,6 +1,8 @@
 (.module:
   {#.doc "Functionality for working with tuples (particularly 2-tuples)."}
-  lux)
+  [lux #*
+   [abstract
+    [equivalence (#+ Equivalence)]]])
 
 (template [<name> <type> <output>]
   [(def: #export (<name> xy)
@@ -43,3 +45,11 @@
         (-> a [l r])))
   (function (_ x)
     [(f x) (g x)]))
+
+(structure: #export (equivalence l@= r@=)
+  (All [l r]
+    (-> (Equivalence l) (Equivalence r)
+        (Equivalence [l r])))
+  (def: (= [lP rP] [lS rS])
+    (and (l@= lP lS)
+         (r@= rP rS))))
diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux
index e1735cf8e..6daaf4869 100644
--- a/stdlib/source/lux/host.jvm.lux
+++ b/stdlib/source/lux/host.jvm.lux
@@ -1438,7 +1438,7 @@
                                     (with-gensyms [arg-name]
                                       (wrap [maybe? arg-name]))))
                                import-member-args)
-         #let [arg-classes (list@map (|>> product.right jvm.signature) import-member-args)
+         #let [arg-classes (list@map (|>> product.right jvm.descriptor) import-member-args)
                arg-types (list@map (: (-> [Bit Type] Code)
                                       (function (_ [maybe? arg])
                                         (let [arg-type (jvm-type (get@ #import-member-mode commons) arg)]
diff --git a/stdlib/source/lux/target/jvm/reflection.lux b/stdlib/source/lux/target/jvm/reflection.lux
index e65b6061f..afea0b0c2 100644
--- a/stdlib/source/lux/target/jvm/reflection.lux
+++ b/stdlib/source/lux/target/jvm/reflection.lux
@@ -23,7 +23,8 @@
 (import: #long java/lang/String)
 
 (import: #long java/lang/Object
-  (toString [] java/lang/String))
+  (toString [] java/lang/String)
+  (getClass [] (java/lang/Class java/lang/Object)))
 
 (import: #long java/lang/reflect/Type
   (getTypeName [] java/lang/String))
@@ -89,10 +90,10 @@
 (template [<name>]
   [(exception: #export (<name> {jvm-type java/lang/reflect/Type})
      (exception.report
-      ["Type" (java/lang/reflect/Type::getTypeName jvm-type)]))]
+      ["Type" (java/lang/reflect/Type::getTypeName jvm-type)]
+      ["Class" (|> jvm-type java/lang/Object::getClass java/lang/Object::toString)]))]
 
   [not-a-class]
-  [cannot-convert-to-a-parameter]
   [cannot-convert-to-a-lux-type]
   )
 
@@ -120,13 +121,22 @@
         _)
       (case (host.check java/lang/reflect/WildcardType reflection)
         (#.Some reflection)
+        ## TODO: Instead of having single lower/upper bounds, should
+        ## allow for multiple ones.
         (case [(array.read 0 (java/lang/reflect/WildcardType::getLowerBounds reflection))
                (array.read 0 (java/lang/reflect/WildcardType::getUpperBounds reflection))]
           (^template [<pattern> <kind>]
             <pattern>
-            (do error.monad
-              [bound (generic bound)]
-              (wrap (#/.Wildcard (#.Some [<kind> bound])))))
+            (case (host.check java/lang/reflect/GenericArrayType bound)
+              (#.Some _)
+              ## TODO: Array bounds should not be "erased" as they
+              ## are right now.
+              (#error.Success (#/.Wildcard #.None))
+
+              _
+              (:: error.monad map
+                  (|>> [<kind>] #.Some #/.Wildcard)
+                  (generic bound))))
           ([[_ (#.Some bound)] #/.Upper]
            [[(#.Some bound) _] #/.Lower])
           
diff --git a/stdlib/source/lux/target/jvm/type.lux b/stdlib/source/lux/target/jvm/type.lux
index 4b62f33a7..2c3b2b1e2 100644
--- a/stdlib/source/lux/target/jvm/type.lux
+++ b/stdlib/source/lux/target/jvm/type.lux
@@ -1,12 +1,15 @@
 (.module:
   [lux (#- Type int char)
+   [abstract
+    [equivalence (#+ Equivalence)]]
    [control
     ["<>" parser
      ["<t>" text (#+ Parser)]]]
    [data
     [error (#+ Error)]
+    ["." product]
     ["." maybe ("#@." functor)]
-    ["." text
+    ["." text ("#@." equivalence)
      format]
     [collection
      ["." list ("#@." functor)]]]])
@@ -56,6 +59,20 @@
   #Lower
   #Upper)
 
+## TODO: Replace with polytypism.
+(structure: #export bound-equivalence
+  (Equivalence Bound)
+  (def: (= parameter subject)
+    (case [parameter subject]
+      (^template [<tag>]
+        [<tag> <tag>]
+        true)
+      ([#Lower]
+       [#Upper])
+
+      _
+      false)))
+
 (type: #export Primitive
   #Boolean
   #Byte
@@ -66,6 +83,26 @@
   #Double
   #Char)
 
+## TODO: Replace with polytypism.
+(structure: #export primitive-equivalence
+  (Equivalence Primitive)
+  (def: (= parameter subject)
+    (case [parameter subject]
+      (^template [<tag>]
+        [<tag> <tag>]
+        true)
+      ([#Boolean]
+       [#Byte]
+       [#Short]
+       [#Int]
+       [#Long]
+       [#Float]
+       [#Double]
+       [#Char])
+
+      _
+      false)))
+
 (type: #export Var Text)
 
 (with-expansions [<Class> (as-is [Text (List Generic)])]
@@ -78,6 +115,24 @@
     <Class>)
   )
 
+(structure: #export generic-equivalence
+  (Equivalence Generic)
+  (def: (= parameter subject)
+    (case [parameter subject]
+      [(#Var parameter) (#Var subject)]
+      (text@= parameter subject)
+
+      [(#Wildcard parameter) (#Wildcard subject)]
+      (:: (maybe.equivalence (product.equivalence bound-equivalence =))
+          = parameter subject)
+
+      [(#Class [nameP paramsP]) (#Class [nameS paramsS])]
+      (and (text@= nameP nameS)
+           (:: (list.equivalence =) = paramsP paramsS))
+
+      _
+      false)))
+
 (type: #export Parameter
   [Text Class (List Class)])
 
@@ -86,17 +141,44 @@
   (#Generic Generic)
   (#Array Type))
 
+(structure: #export type-equivalence
+  (Equivalence Type)
+  (def: (= parameter subject)
+    (case [parameter subject]
+      [(#Primitive parameter) (#Primitive subject)]
+      (:: ..primitive-equivalence = parameter subject)
+
+      [(#Generic parameter) (#Generic subject)]
+      (:: ..generic-equivalence = parameter subject)
+
+      [(#Array parameter) (#Array subject)]
+      (= parameter subject)
+
+      _
+      false)))
+
 (type: #export Argument
   [Text Type])
 
 (type: #export Return
   (Maybe Type))
 
+(def: #export return-equivalence
+  (Equivalence Return)
+  (maybe.equivalence ..type-equivalence))
+
 (type: #export Method
   {#args (List Type)
    #return Return
    #exceptions (List Generic)})
 
+(structure: #export method-equivalence
+  (Equivalence Method)
+  (def: (= [argsP returnP exceptionsP] [argsS returnS exceptionsS])
+    (and (:: (list.equivalence ..type-equivalence) = argsP argsS)
+         (:: ..return-equivalence = returnP returnS)
+         (:: (list.equivalence ..generic-equivalence) = exceptionsP exceptionsS))))
+
 (type: #export (Typed a)
   [Type a])
 
diff --git a/stdlib/source/lux/target/jvm/type/lux.lux b/stdlib/source/lux/target/jvm/type/lux.lux
index 92bc05091..2e1529ba6 100644
--- a/stdlib/source/lux/target/jvm/type/lux.lux
+++ b/stdlib/source/lux/target/jvm/type/lux.lux
@@ -92,11 +92,11 @@
     (#//.Array elementT)
     (case elementT
       (#//.Primitive primitive)
-      (check@wrap (#.Primitive (//.descriptor (//.array 1 input)) #.Nil))
+      (check@wrap (#.Primitive (//.descriptor input) #.Nil))
 
       _
       (do check.monad
-        [elementT (type mapping input)]
+        [elementT (type mapping elementT)]
         (wrap (.type (Array elementT)))))))
 
 (def: #export (return mapping input)
diff --git a/stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux b/stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux
index 8679135f1..e14a528b2 100644
--- a/stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux
+++ b/stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux
@@ -26,6 +26,7 @@
     ["." jvm #_
      [".!" reflection]
      ["#" type (#+ Var Bound Primitive Generic Class Type Argument Return Method Typed)
+      ("method@." method-equivalence)
       ["." box]
       ["." reflection]
       [".T" lux (#+ Mapping)]]]]]
@@ -928,7 +929,7 @@
     [parameters (|> (java/lang/reflect/Method::getGenericParameterTypes method)
                     array.to-list
                     (monad.map error.monad reflection!.type)
-                    (:: error.monad map (list@map jvm.signature))
+                    (:: error.monad map (list@map jvm.descriptor))
                     ////.lift)
      #let [modifiers (java/lang/reflect/Method::getModifiers method)
            correct-class? (java/lang/Object::equals class (java/lang/reflect/Method::getDeclaringClass method))
@@ -965,7 +966,7 @@
     [parameters (|> (java/lang/reflect/Constructor::getGenericParameterTypes constructor)
                     array.to-list
                     (monad.map error.monad reflection!.type)
-                    (:: error.monad map (list@map jvm.signature))
+                    (:: error.monad map (list@map jvm.descriptor))
                     ////.lift)]
     (wrap (and (java/lang/Object::equals class (java/lang/reflect/Constructor::getDeclaringClass constructor))
                (n/= (list.size arg-classes) (list.size parameters))
@@ -1431,35 +1432,54 @@
   (-> (Typed Analysis) Analysis)
   (/////analysis.tuple (list (type-analysis type) term)))
 
-(def: abstract-methods
-  (-> (java/lang/Class java/lang/Object)
-      (Error (List [Text Method])))
-  (|>> java/lang/Class::getDeclaredMethods
-       array.to-list
-       (list.filter (|>> java/lang/reflect/Method::getModifiers java/lang/reflect/Modifier::isAbstract))
-       (monad.map error.monad
-                  (function (_ method)
-                    (do error.monad
-                      [inputs (|> (java/lang/reflect/Method::getGenericParameterTypes method)
-                                  array.to-list
-                                  (monad.map @ reflection!.type))
-                       return (|> method
-                                  java/lang/reflect/Method::getGenericReturnType
-                                  reflection!.return)
-                       exceptions (|> (java/lang/reflect/Method::getGenericExceptionTypes method)
-                                      array.to-list
-                                      (monad.map @ reflection!.generic))]
-                      (wrap [(java/lang/reflect/Method::getName method)
-                             (jvm.method inputs return exceptions)]))))))
+(template [<name> <filter>]
+  [(def: <name>
+     (-> (java/lang/Class java/lang/Object)
+         (Error (List [Text Method])))
+     (|>> java/lang/Class::getDeclaredMethods
+          array.to-list
+          <filter>
+          (monad.map error.monad
+                     (function (_ method)
+                       (do error.monad
+                         [inputs (|> (java/lang/reflect/Method::getGenericParameterTypes method)
+                                     array.to-list
+                                     (monad.map @ reflection!.type))
+                          return (|> method
+                                     java/lang/reflect/Method::getGenericReturnType
+                                     reflection!.return)
+                          exceptions (|> (java/lang/reflect/Method::getGenericExceptionTypes method)
+                                         array.to-list
+                                         (monad.map @ reflection!.generic))]
+                         (wrap [(java/lang/reflect/Method::getName method)
+                                (jvm.method inputs return exceptions)]))))))]
+
+  [abstract-methods (list.filter (|>> java/lang/reflect/Method::getModifiers java/lang/reflect/Modifier::isAbstract))]
+  [methods (<|)]
+  )
 
 (def: jvm-package-separator ".")
 
-(def: all-abstract-methods
-  (-> (List Class) (Error (List [Text Method])))
-  (|>> (monad.map error.monad (|>> product.left reflection!.load))
-       (error@map (monad.map error.monad ..abstract-methods))
-       error@join
-       (error@map list@join)))
+(template [<name> <methods>]
+  [(def: <name>
+     (-> (List Class) (Error (List [Text Method])))
+     (|>> (monad.map error.monad (|>> product.left reflection!.load))
+          (error@map (monad.map error.monad <methods>))
+          error@join
+          (error@map list@join)))]
+
+  [all-abstract-methods ..abstract-methods]
+  [all-methods ..methods]
+  )
+
+(template [<name>]
+  [(exception: #export (<name> {methods (List Text)})
+     (exception.report
+      ["Methods" (exception.enumerate %t methods)]))]
+
+  [missing-abstract-methods]
+  [invalid-overriden-methods]
+  )
 
 (def: class::anonymous
   Handler
@@ -1546,7 +1566,38 @@
                                                                              )))))
                                       methods)
                   required-abstract-methods (////.lift (all-abstract-methods (list& super-class super-interfaces)))
-                  _ (typeA.infer selfT)]
+                  available-methods (////.lift (all-methods (list& super-class super-interfaces)))
+                  #let [overriden-methods (list@map (function (_ [parent-type method-name
+                                                                  strict-fp? annotations vars
+                                                                  self-name arguments return exceptions
+                                                                  body])
+                                                      [method-name (jvm.method (list@map product.right arguments)
+                                                                               return
+                                                                               (list@map (|>> #jvm.Class) exceptions))])
+                                                    methods)
+                        missing-abstract-methods (list.filter (function (_ [abstract-method-name abstract-methodJT])
+                                                                (|> overriden-methods
+                                                                    (list.filter (function (_ [method-name methodJT])
+                                                                                   (and (text@= method-name abstract-method-name)
+                                                                                        (method@= abstract-methodJT methodJT))))
+                                                                    list.size
+                                                                    (n/= 1)
+                                                                    not))
+                                                              required-abstract-methods)
+                        invalid-overriden-methods (list.filter (function (_ [method-name methodJT])
+                                                                 (|> available-methods
+                                                                     (list.filter (function (_ [abstract-method-name abstract-methodJT])
+                                                                                    (and (text@= method-name abstract-method-name)
+                                                                                         (method@= abstract-methodJT methodJT))))
+                                                                     list.size
+                                                                     (n/= 1)
+                                                                     not))
+                                                               overriden-methods)]
+                  _ (typeA.infer selfT)
+                  _ (////.assert ..missing-abstract-methods (list@map product.left missing-abstract-methods)
+                                 (list.empty? missing-abstract-methods))
+                  _ (////.assert ..invalid-overriden-methods (list@map product.left invalid-overriden-methods)
+                                 (list.empty? invalid-overriden-methods))]
                  (wrap (#/////analysis.Extension extension-name
                                                  (list (/////analysis.text name)
                                                        (class-analysis super-class)