Now allowing types for methods.

5 files changed, 107 insertions, 88 deletions

diff --git a/stdlib/source/lux/target/jvm/type.lux b/stdlib/source/lux/target/jvm/type.lux
index e5190429b..e5c7304ee 100644
--- a/stdlib/source/lux/target/jvm/type.lux
+++ b/stdlib/source/lux/target/jvm/type.lux
@@ -16,7 +16,7 @@
    [encoding
     ["#." name (#+ External)]]]
   ["." / #_
-   [category (#+ Void Value Return Method Primitive Object Class Array Var Parameter Declaration)]
+   [category (#+ Void Value' Value Return' Return Method Primitive Object Class Array Var Parameter Declaration)]
    ["#." signature (#+ Signature)]
    ["#." descriptor (#+ Descriptor)]
    ["#." reflection (#+ Reflection)]])
@@ -45,9 +45,15 @@
 
     [signature Signature]
     [descriptor Descriptor]
-    [reflection Reflection]
     )
 
+  (def: #export (reflection type)
+    (All [category]
+      (-> (Type (<| Return' Value' category))
+          (Reflection (<| Return' Value' category))))
+    (let [[signature descriptor reflection] (:representation type)]
+      reflection))
+
   (template [<category> <name> <signature> <descriptor> <reflection>]
     [(def: #export <name>
        (Type <category>)
@@ -88,9 +94,10 @@
   (def: #export (as-class type)
     (-> (Type Declaration) (Type Class))
     (:abstraction
-     [(/signature.as-class (..signature type))
-      (/descriptor.as-class (..descriptor type))
-      (/reflection.as-class (..reflection type))]))
+     (let [[signature descriptor reflection] (:representation type)]
+       [(/signature.as-class signature)
+        (/descriptor.as-class descriptor)
+        (/reflection.as-class reflection)])))
 
   (def: #export wildcard
     (Type Parameter)
@@ -109,28 +116,31 @@
   (def: #export (lower bound)
     (-> (Type Class) (Type Parameter))
     (:abstraction
-     [(/signature.lower (..signature bound))
-      (/descriptor.lower (..descriptor bound))
-      (/reflection.lower (..reflection bound))]))
+     (let [[signature descriptor reflection] (:representation bound)]
+       [(/signature.lower signature)
+        (/descriptor.lower descriptor)
+        (/reflection.lower reflection)])))
 
   (def: #export (upper bound)
     (-> (Type Class) (Type Parameter))
     (:abstraction
-     [(/signature.upper (..signature bound))
-      (/descriptor.upper (..descriptor bound))
-      (/reflection.upper (..reflection bound))]))
+     (let [[signature descriptor reflection] (:representation bound)]
+       [(/signature.upper signature)
+        (/descriptor.upper descriptor)
+        (/reflection.upper reflection)])))
 
   (def: #export (method [inputs output exceptions])
     (-> [(List (Type Value))
          (Type Return)
          (List (Type Class))]
-        [(Signature Method)
-         (Descriptor Method)])
-    [(/signature.method [(list@map ..signature inputs)
-                         (..signature output)
-                         (list@map ..signature exceptions)])
-     (/descriptor.method [(list@map ..descriptor inputs)
-                          (..descriptor output)])])
+        (Type Method))
+    (:abstraction
+     [(/signature.method [(list@map ..signature inputs)
+                          (..signature output)
+                          (list@map ..signature exceptions)])
+      (/descriptor.method [(list@map ..descriptor inputs)
+                           (..descriptor output)])
+      (:assume ..void)]))
 
   (structure: #export equivalence
     (All [category] (Equivalence (Type category)))
diff --git a/stdlib/source/lux/target/jvm/type/alias.lux b/stdlib/source/lux/target/jvm/type/alias.lux
index cd631a251..49b4c0297 100644
--- a/stdlib/source/lux/target/jvm/type/alias.lux
+++ b/stdlib/source/lux/target/jvm/type/alias.lux
@@ -8,7 +8,6 @@
     ["<>" parser ("#@." monad)
      ["<t>" text (#+ Parser)]]]
    [data
-    ["." product]
     ["." maybe]
     ["." text
      ["%" format (#+ format)]]
@@ -86,6 +85,12 @@
          (//parser.array' value)
          ))))
 
+(def: (inputs aliasing)
+  (-> Aliasing (Parser (List (Type Value))))
+  (|> (<>.some (..value aliasing))
+      (<>.after (<t>.this //signature.arguments-start))
+      (<>.before (<t>.this //signature.arguments-end))))
+
 (def: (return aliasing)
   (-> Aliasing (Parser (Type Return)))
   ($_ <>.either
@@ -93,19 +98,19 @@
       (..value aliasing)
       ))
 
-(def: #export (method aliasing signature)
-  (-> Aliasing (Signature Method) (Signature Method))
-  (let [parameters (: (Parser (List (Type Value)))
-                      (|> (<>.some (..value aliasing))
-                          (<>.after (<t>.this //signature.arguments-start))
-                          (<>.before (<t>.this //signature.arguments-end))))
-        exception (: (Parser (Type Class))
-                     (|> (..class (..parameter aliasing))
-                         (<>.after (<t>.this //signature.exception-prefix))))]
-    (|> (//signature.signature signature)
-        (<t>.run (do <>.monad
-                   [parameters parameters
-                    return (..return aliasing)
-                    exceptions (<>.some exception)]
-                   (wrap (product.left (//.method [parameters return exceptions])))))
-        try.assume)))
+(def: (exception aliasing)
+  (-> Aliasing (Parser (Type Class)))
+  (|> (..class (..parameter aliasing))
+      (<>.after (<t>.this //signature.exception-prefix))))
+
+(def: #export (method aliasing type)
+  (-> Aliasing (Type Method) (Type Method))
+  (|> type
+      //.signature
+      //signature.signature
+      (<t>.run (do <>.monad
+                 [inputs (..inputs aliasing)
+                  return (..return aliasing)
+                  exceptions (<>.some (..exception aliasing))]
+                 (wrap (//.method [inputs return exceptions]))))
+      try.assume))
diff --git a/stdlib/source/lux/target/jvm/type/parser.lux b/stdlib/source/lux/target/jvm/type/parser.lux
index 99f4a57ee..298364357 100644
--- a/stdlib/source/lux/target/jvm/type/parser.lux
+++ b/stdlib/source/lux/target/jvm/type/parser.lux
@@ -15,9 +15,8 @@
      ["." list]]]]
   ["." // (#+ Type)
    [category (#+ Void Value Return Method Primitive Object Class Array Var Parameter Declaration)]
-   ["#." signature (#+ Signature)]
-   ["#." descriptor (#+ Descriptor)]
-   ["#." reflection (#+ Reflection)]
+   ["#." signature]
+   ["#." descriptor]
    ["." // #_
     [encoding
      ["#." name (#+ External)]]]])
@@ -197,8 +196,7 @@
              ..value))
 
 (def: #export method
-  (Parser [(Signature Method)
-           (Descriptor Method)])
+  (Parser (Type Method))
   (let [parameters (: (Parser (List (Type Value)))
                       (|> (<>.some ..value)
                           (<>.after (<t>.this //signature.arguments-start))
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 98cf8baf8..8202fd101 100644
--- a/stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux
+++ b/stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux
@@ -30,11 +30,11 @@
      [encoding
       [name (#+ External)]]
      ["#" type (#+ Type Argument Typed) ("#@." equivalence)
-      ["." category (#+ Void Value Return Primitive Object Class Array Var Parameter Method)]
+      ["." category (#+ Void Value' Value Return' Return Primitive Object Class Array Var Parameter Method)]
       ["." box]
       ["." reflection]
-      ["." descriptor (#+ Descriptor)]
-      ["." signature (#+ Signature) ("#@." equivalence)]
+      ["." descriptor]
+      ["." signature]
       ["#-." parser]
       ["#-." alias (#+ Aliasing)]
       [".T" lux (#+ Mapping)]]]]]
@@ -55,10 +55,14 @@
        [archive
         [descriptor (#+ Module)]]]]]]])
 
-(def: reflection (|>> jvm.reflection reflection.reflection))
+(def: reflection
+  (All [category]
+    (-> (Type (<| Return' Value' category)) Text))
+  (|>> jvm.reflection reflection.reflection))
+
 (def: signature (|>> jvm.signature signature.signature))
 
-(def: object-class "java.lang.Object")
+(def: object-class External "java.lang.Object")
 
 (def: inheritance-relationship-type-name "_jvm_inheritance")
 (def: #export (inheritance-relationship-type class super-class super-interfaces)
@@ -319,7 +323,8 @@
       (^ (list arrayC))
       (do ////.monad
         [_ (typeA.infer ..int)
-         arrayA (typeA.with-type (#.Primitive (|> (jvm.array primitive-type) ..reflection)
+         arrayA (typeA.with-type (#.Primitive (|> (jvm.array primitive-type)
+                                                  ..reflection)
                                               (list))
                   (analyse arrayC))]
         (wrap (#/////analysis.Extension extension-name (list arrayA))))
@@ -791,26 +796,20 @@
   (getConstructors [] [(java/lang/reflect/Constructor java/lang/Object)])
   (getDeclaredMethods [] [java/lang/reflect/Method]))
 
-(def: (reflection-type mapping typeJ)
-  (-> Mapping (Type Value) (Operation .Type))
-  (case (|> typeJ jvm.signature signature.signature
-            (<t>.run (luxT.type mapping)))
-    (#try.Success check)
-    (typeA.with-env
-      check)
-    
-    (#try.Failure error)
-    (////.fail error)))
-
-(def: (reflection-return mapping typeJ)
-  (-> Mapping (Type Return) (Operation .Type))
-  (case (|> typeJ ..signature (<t>.run (luxT.return mapping)))
-    (#try.Success check)
-    (typeA.with-env
-      check)
-    
-    (#try.Failure error)
-    (////.fail error)))
+(template [<name> <category> <parser>]
+  [(def: (<name> mapping typeJ)
+     (-> Mapping (Type <category>) (Operation .Type))
+     (case (|> typeJ ..signature (<t>.run (<parser> mapping)))
+       (#try.Success check)
+       (typeA.with-env
+         check)
+       
+       (#try.Failure error)
+       (////.fail error)))]
+
+  [reflection-type Value luxT.type]
+  [reflection-return Return luxT.return]
+  )
 
 (def: (class-candidate-parents from-name fromT to-name to-class)
   (-> External .Type External (java/lang/Class java/lang/Object) (Operation (List [[Text .Type] Bit])))
@@ -1462,7 +1461,7 @@
 (template [<name> <filter>]
   [(def: <name>
      (-> (java/lang/Class java/lang/Object)
-         (Try (List [Text (Signature Method)])))
+         (Try (List [Text (Type Method)])))
      (|>> java/lang/Class::getDeclaredMethods
           array.to-list
           <filter>
@@ -1479,7 +1478,7 @@
                                          array.to-list
                                          (monad.map @ reflection!.class))]
                          (wrap [(java/lang/reflect/Method::getName method)
-                                (product.left (jvm.method [inputs return exceptions]))]))))))]
+                                (jvm.method [inputs return exceptions])]))))))]
 
   [abstract-methods (list.filter (|>> java/lang/reflect/Method::getModifiers java/lang/reflect/Modifier::isAbstract))]
   [methods (<|)]
@@ -1489,7 +1488,7 @@
 
 (template [<name> <methods>]
   [(def: <name>
-     (-> (List (Type Class)) (Try (List [Text (Signature Method)])))
+     (-> (List (Type Class)) (Try (List [Text (Type Method)])))
      (|>> (monad.map try.monad (|>> ..reflection reflection!.load))
           (try@map (monad.map try.monad <methods>))
           try@join
@@ -1500,11 +1499,11 @@
   )
 
 (template [<name>]
-  [(exception: #export (<name> {methods (List [Text (Signature Method)])})
+  [(exception: #export (<name> {methods (List [Text (Type Method)])})
      (exception.report
       ["Methods" (exception.enumerate
-                  (function (_ [name signature])
-                    (format (%.text name) " " (signature.signature signature)))
+                  (function (_ [name type])
+                    (format (%.text name) " " (..signature type)))
                   methods)]))]
 
   [missing-abstract-methods]
@@ -1853,12 +1852,14 @@
                  (wrap [parameterJ parameterT])))))
 
 (def: (mismatched-methods super-set sub-set)
-  (-> (List [Text (Signature Method)]) (List [Text (Signature Method)]) (List [Text (Signature Method)]))
+  (-> (List [Text (Type Method)])
+      (List [Text (Type Method)])
+      (List [Text (Type Method)]))
   (list.filter (function (_ [sub-name subJT])
                  (|> super-set
                      (list.filter (function (_ [super-name superJT])
                                     (and (text@= super-name sub-name)
-                                         (signature@= superJT subJT))))
+                                         (jvm@= superJT subJT))))
                      list.size
                      (n.= 1)
                      not))
@@ -1954,7 +1955,6 @@
                                             (wrap [method-name (|> (jvm.method [(list@map product.right arguments)
                                                                                 return
                                                                                 exceptions])
-                                                                   product.left
                                                                    (jvm-alias.method aliasing))])))
                                       methods)
          #let [missing-abstract-methods (mismatched-methods overriden-methods required-abstract-methods)
diff --git a/stdlib/source/test/lux/extension.lux b/stdlib/source/test/lux/extension.lux
index 645558d5f..7b2d9ffd5 100644
--- a/stdlib/source/test/lux/extension.lux
+++ b/stdlib/source/test/lux/extension.lux
@@ -1,5 +1,6 @@
 (.module:
   [lux #*
+   ["@" target]
    [abstract
     [monad (#+ do)]]
    [control
@@ -23,24 +24,29 @@
 
 (def: my-extension "example YOLO")
 
-(analysis: (..my-extension self phase {parameters (<>.some <c>.any)})
-  (do @
-    [_ (type.infer .Text)]
-    (wrap (#analysis.Extension self (list)))))
+(`` (for {(~~ (static @.old))
+          (as-is)}
+         (as-is (analysis: (..my-extension self phase {parameters (<>.some <c>.any)})
+                  (do @
+                    [_ (type.infer .Text)]
+                    (wrap (#analysis.Extension self (list)))))
 
-(synthesis: (..my-extension self phase {parameters (<>.some <a>.any)})
-  (wrap (synthesis.text self)))
+                (synthesis: (..my-extension self phase {parameters (<>.some <a>.any)})
+                  (wrap (synthesis.text self)))
 
-(directive: (..my-extension self phase {parameters (<>.some <c>.any)})
-  (do @
-    [#let [_ (log! (format "directive: " (%.text self)))]]
-    (wrap directive.no-requirements)))
+                (directive: (..my-extension self phase {parameters (<>.some <c>.any)})
+                  (do @
+                    [#let [_ (log! (format "directive: " (%.text self)))]]
+                    (wrap directive.no-requirements)))
 
-("example YOLO")
+                ("example YOLO")
+                )))
 
 (def: #export test
   Test
   (<| (_.context (%.name (name-of /._)))
       (_.test "Can define and use analysis & synthesis extensions."
-              (text@= ("example YOLO")
-                      "example YOLO"))))
+              (`` (for {(~~ (static @.old))
+                        false}
+                       (text@= ("example YOLO")
+                               "example YOLO"))))))