Automatically handling input/output conversions for methods in new JVM compiler.

2 files changed, 120 insertions, 35 deletions

diff --git a/stdlib/source/library/lux/target/jvm/type/lux.lux b/stdlib/source/library/lux/target/jvm/type/lux.lux
index 45fd34c8d..b4abe4093 100644
--- a/stdlib/source/library/lux/target/jvm/type/lux.lux
+++ b/stdlib/source/library/lux/target/jvm/type/lux.lux
@@ -7,7 +7,7 @@
      ["." try]
      ["." exception (#+ exception:)]
      ["<>" parser ("#\." monad)
-      ["<t>" text (#+ Parser)]]]
+      ["<.>" text (#+ Parser)]]]
     [data
      ["." product]
      ["." text ("#\." equivalence)
@@ -24,6 +24,7 @@
    ["#." signature]
    ["#." reflection]
    ["#." parser]
+   ["#." box]
    ["/#" // #_
     [encoding
      ["#." name]]]])
@@ -66,6 +67,22 @@
   [char //parser.char //reflection.char]
   )
 
+(template [<name> <parser> <box>]
+  [(def: <name>
+     (Parser (Check Type))
+     (<>.after <parser>
+               (<>\wrap (check\wrap (#.Primitive <box> #.Nil)))))]
+
+  [boxed_boolean //parser.boolean //box.boolean]
+  [boxed_byte //parser.byte //box.byte]
+  [boxed_short //parser.short //box.short]
+  [boxed_int //parser.int //box.int]
+  [boxed_long //parser.long //box.long]
+  [boxed_float //parser.float //box.float]
+  [boxed_double //parser.double //box.double]
+  [boxed_char //parser.char //box.char]
+  )
+
 (def: primitive
   (Parser (Check Type))
   ($_ <>.either
@@ -79,6 +96,19 @@
       ..char
       ))
 
+(def: boxed_primitive
+  (Parser (Check Type))
+  ($_ <>.either
+      ..boxed_boolean
+      ..boxed_byte
+      ..boxed_short
+      ..boxed_int
+      ..boxed_long
+      ..boxed_float
+      ..boxed_double
+      ..boxed_char
+      ))
+
 (def: wildcard
   (Parser (Check Type))
   (<>.after //parser.wildcard
@@ -101,19 +131,19 @@
   (|> (do <>.monad
         [name //parser.class_name
          parameters (|> (<>.some parameter)
-                        (<>.after (<t>.this //signature.parameters_start))
-                        (<>.before (<t>.this //signature.parameters_end))
+                        (<>.after (<text>.this //signature.parameters_start))
+                        (<>.before (<text>.this //signature.parameters_end))
                         (<>.default (list)))]
         (wrap (do {! check.monad}
                 [parameters (monad.seq ! parameters)]
                 (wrap (#.Primitive name parameters)))))
-      (<>.after (<t>.this //descriptor.class_prefix))
-      (<>.before (<t>.this //descriptor.class_suffix))))
+      (<>.after (<text>.this //descriptor.class_prefix))
+      (<>.before (<text>.this //descriptor.class_suffix))))
 
 (template [<name> <prefix> <constructor>]
   [(def: <name>
      (-> (Parser (Check Type)) (Parser (Check Type)))
-     (|> (<>.after (<t>.this <prefix>))
+     (|> (<>.after (<text>.this <prefix>))
          ## TODO: Re-enable Lower and Upper, instead of using the simplified limit.
          ## (<>\map (check\map (|>> <ctor> .type)))
          ))]
@@ -160,7 +190,7 @@
 
                               _
                               (|> elementT array.Array .type)))))
-       (<>.after (<t>.this //descriptor.array_prefix))))
+       (<>.after (<text>.this //descriptor.array_prefix))))
 
 (def: #export (type mapping)
   (-> Mapping (Parser (Check Type)))
@@ -172,6 +202,16 @@
          (..array type)
          ))))
 
+(def: #export (boxed_type mapping)
+  (-> Mapping (Parser (Check Type)))
+  (<>.rec
+   (function (_ type)
+     ($_ <>.either
+         ..boxed_primitive
+         (parameter mapping)
+         (..array type)
+         ))))
+
 (def: #export (return mapping)
   (-> Mapping (Parser (Check Type)))
   ($_ <>.either
@@ -179,9 +219,16 @@
       (..type mapping)
       ))
 
+(def: #export (boxed_return mapping)
+  (-> Mapping (Parser (Check Type)))
+  ($_ <>.either
+      ..void
+      (..boxed_type mapping)
+      ))
+
 (def: #export (check operation input)
   (All [a] (-> (Parser (Check a)) Text (Check a)))
-  (case (<t>.run operation input)
+  (case (<text>.run operation input)
     (#try.Success check)
     check
     
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux
index 66f7271db..e5af044c3 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux
@@ -853,7 +853,9 @@
        (#try.Failure error)
        (phase.fail error)))]
 
+  [boxed_reflection_type Value luxT.boxed_type]
   [reflection_type Value luxT.type]
+  [boxed_reflection_return Return luxT.boxed_return]
   [reflection_return Return luxT.return]
   )
 
@@ -1679,7 +1681,7 @@
        arguments' (monad.map !
                              (function (_ [name jvmT])
                                (do !
-                                 [luxT (reflection_type mapping jvmT)]
+                                 [luxT (boxed_reflection_type mapping jvmT)]
                                  (wrap [name luxT])))
                              arguments)
        [scope bodyA] (|> arguments'
@@ -1755,7 +1757,7 @@
        arguments' (monad.map !
                              (function (_ [name jvmT])
                                (do !
-                                 [luxT (reflection_type mapping jvmT)]
+                                 [luxT (boxed_reflection_type mapping jvmT)]
                                  (wrap [name luxT])))
                              arguments)
        [scope bodyA] (|> arguments'
@@ -1829,7 +1831,7 @@
        arguments' (monad.map !
                              (function (_ [name jvmT])
                                (do !
-                                 [luxT (reflection_type mapping jvmT)]
+                                 [luxT (boxed_reflection_type mapping jvmT)]
                                  (wrap [name luxT])))
                              arguments)
        [scope bodyA] (|> arguments'
@@ -1944,6 +1946,35 @@
                      mapping
                      override_mapping))))
 
+(def: #export (hide_method_body arity bodyA)
+  (-> Nat Analysis Analysis)
+  (<| /////analysis.tuple
+      (list (/////analysis.unit))
+      (case arity
+        (^or 0 1)
+        bodyA
+        
+        2
+        (#/////analysis.Case (/////analysis.unit)
+                             [{#/////analysis.when
+                               (#/////analysis.Bind 2)
+                               
+                               #/////analysis.then
+                               bodyA}
+                              (list)])
+
+        _
+        (#/////analysis.Case (/////analysis.unit)
+                             [{#/////analysis.when
+                               (#/////analysis.Complex
+                                (#/////analysis.Tuple (|> arity
+                                                          list.indices
+                                                          (list\map (|>> (n.+ 2) #/////analysis.Bind)))))
+                               
+                               #/////analysis.then
+                               bodyA}
+                              (list)]))))
+
 (def: #export (analyse_overriden_method analyse archive selfT mapping supers method)
   (-> Phase Archive .Type Mapping (List (Type Class)) (Overriden_Method Code) (Operation Analysis))
   (let [[parent_type method_name
@@ -1965,10 +1996,10 @@
        arguments' (monad.map !
                              (function (_ [name jvmT])
                                (do !
-                                 [luxT (reflection_type mapping jvmT)]
+                                 [luxT (boxed_reflection_type mapping jvmT)]
                                  (wrap [name luxT])))
                              arguments)
-       returnT (reflection_return mapping return)
+       returnT (boxed_reflection_return mapping return)
        [scope bodyA] (|> arguments'
                          (#.Cons [self_name selfT])
                          list.reverse
@@ -1989,7 +2020,7 @@
                                        (#/////analysis.Function
                                         (list\map (|>> /////analysis.variable)
                                                   (scope.environment scope))
-                                        (/////analysis.tuple (list bodyA)))
+                                        (..hide_method_body (list.size arguments) bodyA))
                                        ))))))
 
 (type: #export (Method_Definition a)
@@ -2052,6 +2083,31 @@
         local (format "anonymous-class" (%.nat id))]
     (format global ..jvm_package_separator local)))
 
+(def: #export (require_complete_method_concretion class_loader supers methods)
+  (-> java/lang/ClassLoader (List (Type Class)) (List (Overriden_Method Code)) (Operation Any))
+  (do {! phase.monad}
+    [required_abstract_methods (phase.lift (all_abstract_methods class_loader supers))
+     available_methods (phase.lift (all_methods class_loader supers))
+     overriden_methods (monad.map ! (function (_ [parent_type method_name
+                                                  strict_fp? annotations type_vars
+                                                  self_name arguments return exceptions
+                                                  body])
+                                      (do !
+                                        [aliasing (super_aliasing class_loader parent_type)]
+                                        (wrap [method_name (|> (jvm.method [type_vars
+                                                                            (list\map product.right arguments)
+                                                                            return
+                                                                            exceptions])
+                                                               (jvm_alias.method aliasing))])))
+                                  methods)
+     #let [missing_abstract_methods (mismatched_methods overriden_methods required_abstract_methods)
+           invalid_overriden_methods (mismatched_methods available_methods overriden_methods)]
+     _ (phase.assert ..missing_abstract_methods missing_abstract_methods
+                     (list.empty? missing_abstract_methods))
+     _ (phase.assert ..invalid_overriden_methods invalid_overriden_methods
+                     (list.empty? invalid_overriden_methods))]
+    (wrap [])))
+
 (def: (class::anonymous class_loader)
   (-> java/lang/ClassLoader Handler)
   (..custom
@@ -2097,27 +2153,9 @@
                                                       (analyse archive term))]
                                              (wrap [type termA])))
                                        constructor_args)
-         methodsA (monad.map ! (analyse_overriden_method analyse archive selfT mapping (#.Cons super_class super_interfaces)) methods)
-         required_abstract_methods (phase.lift (all_abstract_methods class_loader (list& super_class super_interfaces)))
-         available_methods (phase.lift (all_methods class_loader (list& super_class super_interfaces)))
-         overriden_methods (monad.map ! (function (_ [parent_type method_name
-                                                      strict_fp? annotations type_vars
-                                                      self_name arguments return exceptions
-                                                      body])
-                                          (do !
-                                            [aliasing (super_aliasing class_loader parent_type)]
-                                            (wrap [method_name (|> (jvm.method [type_vars
-                                                                                (list\map product.right arguments)
-                                                                                return
-                                                                                exceptions])
-                                                                   (jvm_alias.method aliasing))])))
-                                      methods)
-         #let [missing_abstract_methods (mismatched_methods overriden_methods required_abstract_methods)
-               invalid_overriden_methods (mismatched_methods available_methods overriden_methods)]
-         _ (phase.assert ..missing_abstract_methods missing_abstract_methods
-                         (list.empty? missing_abstract_methods))
-         _ (phase.assert ..invalid_overriden_methods invalid_overriden_methods
-                         (list.empty? invalid_overriden_methods))]
+         #let [supers (#.Cons super_class super_interfaces)]
+         _ (..require_complete_method_concretion class_loader supers methods)
+         methodsA (monad.map ! (analyse_overriden_method analyse archive selfT mapping supers) methods)]
         (wrap (#/////analysis.Extension extension_name
                                         (list (class_analysis super_class)
                                               (/////analysis.tuple (list\map class_analysis super_interfaces))