Added an easy way to export Lux functionality to host programs (in JVM).

5 files changed, 131 insertions, 148 deletions

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 8e12692c9..ea13344ed 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
@@ -917,7 +917,7 @@
                 (function (_ superJT)
                   (do !
                     [superJT (phase.lifted (reflection!.type superJT))
-                     .let [super_name (|> superJT ..reflection)]
+                     .let [super_name (..reflection superJT)]
                      super_class (phase.lifted (reflection!.load class_loader super_name))
                      superT (reflection_type mapping superJT)]
                     (in [[super_name superT] (java/lang/Class::isAssignableFrom super_class target_class)])))
@@ -1042,7 +1042,7 @@
         (in (<| {/////analysis.#Extension extension_name}
                 (list (/////analysis.text class)
                       (/////analysis.text field)
-                      (/////analysis.text (|> fieldJT ..reflection)))))))]))
+                      (/////analysis.text (..signature fieldJT)))))))]))
 
 (def: (put::static class_loader)
   (-> java/lang/ClassLoader Handler)
@@ -1058,14 +1058,15 @@
                                          (reflection!.static_field field class)))
          _ (phase.assertion ..deprecated_field [class field]
                             (not deprecated?))
-         _ (phase.assertion ..cannot_set_a_final_field [class field]
-                            (not final?))
+         ... _ (phase.assertion ..cannot_set_a_final_field [class field]
+         ...                    (not final?))
          fieldT (reflection_type luxT.fresh fieldJT)
          valueA (<| (typeA.expecting fieldT)
                     (analyse archive valueC))]
         (in (<| {/////analysis.#Extension extension_name}
                 (list (/////analysis.text class)
                       (/////analysis.text field)
+                      (/////analysis.text (..signature fieldJT))
                       valueA)))))]))
 
 (def: (get::virtual class_loader)
@@ -1090,7 +1091,7 @@
         (in (<| {/////analysis.#Extension extension_name}
                 (list (/////analysis.text class)
                       (/////analysis.text field)
-                      (/////analysis.text (..reflection fieldJT))
+                      (/////analysis.text (..signature fieldJT))
                       objectA)))))]))
 
 (def: (put::virtual class_loader)
@@ -1119,7 +1120,7 @@
         (in (<| {/////analysis.#Extension extension_name}
                 (list (/////analysis.text class)
                       (/////analysis.text field)
-                      (/////analysis.text (..reflection fieldJT))
+                      (/////analysis.text (..signature fieldJT))
                       valueA
                       objectA)))))]))
 
@@ -1775,6 +1776,14 @@
 (type: Exception
   (Type Class))
 
+(def: .public parameter_types
+  (-> (List (Type Var)) (Check (List [(Type Var) .Type])))
+  (monad.each check.monad
+              (function (_ parameterJ)
+                (do check.monad
+                  [[_ parameterT] check.existential]
+                  (in [parameterJ parameterT])))))
+
 (type: .public (Abstract_Method a)
   [Text
    Visibility
@@ -1799,11 +1808,24 @@
           ..return
           (<code>.tuple (<>.some ..class)))))
 
+(def: (method_mapping of_class parameters)
+  (-> Mapping (List (Type Var)) (Check Mapping))
+  (|> parameters
+      ..parameter_types
+      (check#each (list#mix (function (_ [parameterJ parameterT] mapping)
+                              (dictionary.has (parser.name parameterJ) parameterT mapping))
+                            of_class))))
+
+(def: class_mapping
+  (-> (List (Type Var)) (Check Mapping))
+  (..method_mapping luxT.fresh))
+
 (def: .public (analyse_abstract_method analyse archive method)
   (-> Phase Archive (Abstract_Method Code) (Operation Analysis))
   (let [[method_name visibility annotations vars arguments return exceptions] method]
     (do [! phase.monad]
-      [annotationsA (monad.each ! (function (_ [name parameters])
+      [mapping (typeA.check (method_mapping luxT.fresh vars))
+       annotationsA (monad.each ! (function (_ [name parameters])
                                     (do !
                                       [parametersA (monad.each ! (function (_ [name value])
                                                                    (do !
@@ -1856,7 +1878,8 @@
          annotations vars exceptions
          self_name arguments super_arguments body] method]
     (do [! phase.monad]
-      [annotationsA (monad.each ! (function (_ [name parameters])
+      [mapping (typeA.check (method_mapping mapping vars))
+       annotationsA (monad.each ! (function (_ [name parameters])
                                     (do !
                                       [parametersA (monad.each ! (function (_ [name value])
                                                                    (do !
@@ -1959,7 +1982,8 @@
          self_name arguments return exceptions
          body] method]
     (do [! phase.monad]
-      [annotationsA (monad.each ! (function (_ [name parameters])
+      [mapping (typeA.check (method_mapping mapping vars))
+       annotationsA (monad.each ! (function (_ [name parameters])
                                     (do !
                                       [parametersA (monad.each ! (function (_ [name value])
                                                                    (do !
@@ -1968,7 +1992,7 @@
                                                                parameters)]
                                       (in [name parametersA])))
                                 annotations)
-       returnT (reflection_return mapping return)
+       :return: (boxed_reflection_return mapping return)
        arguments' (monad.each !
                               (function (_ [name jvmT])
                                 (do !
@@ -1979,7 +2003,7 @@
                          {.#Item [self_name selfT]}
                          list.reversed
                          (list#mix scope.with_local (analyse archive body))
-                         (typeA.expecting returnT)
+                         (typeA.expecting :return:)
                          scope.with)]
       (in (/////analysis.tuple (list (/////analysis.text ..virtual_tag)
                                      (/////analysis.text method_name)
@@ -2033,7 +2057,8 @@
          arguments return exceptions
          body] method]
     (do [! phase.monad]
-      [annotationsA (monad.each ! (function (_ [name parameters])
+      [mapping (typeA.check (method_mapping mapping vars))
+       annotationsA (monad.each ! (function (_ [name parameters])
                                     (do !
                                       [parametersA (monad.each ! (function (_ [name value])
                                                                    (do !
@@ -2042,7 +2067,7 @@
                                                                parameters)]
                                       (in [name parametersA])))
                                 annotations)
-       returnT (reflection_return mapping return)
+       :return: (boxed_reflection_return mapping return)
        arguments' (monad.each !
                               (function (_ [name jvmT])
                                 (do !
@@ -2052,7 +2077,7 @@
        [scope bodyA] (|> arguments'
                          list.reversed
                          (list#mix scope.with_local (analyse archive body))
-                         (typeA.expecting returnT)
+                         (typeA.expecting :return:)
                          scope.with)]
       (in (/////analysis.tuple (list (/////analysis.text ..static_tag)
                                      (/////analysis.text method_name)
@@ -2141,19 +2166,6 @@
       {.#None}
       (phase.lifted (exception.except ..unknown_super [parent_name supers])))))
 
-(def: .public (with_fresh_type_vars vars mapping)
-  (-> (List (Type Var)) Mapping (Operation Mapping))
-  (do [! phase.monad]
-    [pairings (monad.each ! (function (_ var)
-                              (do !
-                                [[_ exT] (typeA.check check.existential)]
-                                (in [var exT])))
-                          vars)]
-    (in (list#mix (function (_ [varJ :var:] mapping)
-                    (dictionary.has (parser.name varJ) :var: mapping))
-                  mapping
-                  pairings))))
-
 (def: .public (with_override_mapping supers parent_type mapping)
   (-> (List (Type Class)) (Type Class) Mapping (Operation Mapping))
   (do phase.monad
@@ -2203,7 +2215,7 @@
          body] method]
     (do [! phase.monad]
       [mapping (..with_override_mapping supers parent_type mapping)
-       mapping (..with_fresh_type_vars vars mapping)
+       mapping (typeA.check (method_mapping mapping vars))
        annotationsA (monad.each ! (function (_ [name parameters])
                                     (do !
                                       [parametersA (monad.each ! (function (_ [name value])
@@ -2219,12 +2231,12 @@
                                   [luxT (boxed_reflection_type mapping jvmT)]
                                   (in [name luxT])))
                               arguments)
-       returnT (boxed_reflection_return mapping return)
+       :return: (boxed_reflection_return mapping return)
        [scope bodyA] (|> arguments'
                          {.#Item [self_name selfT]}
                          list.reversed
                          (list#mix scope.with_local (analyse archive body))
-                         (typeA.expecting returnT)
+                         (typeA.expecting :return:)
                          scope.with)]
       (in (/////analysis.tuple (list (/////analysis.text ..overriden_tag)
                                      (class_analysis parent_type)
@@ -2243,14 +2255,6 @@
                                       (..hidden_method_body (list.size arguments) bodyA)}
                                      ))))))
 
-(def: .public parameter_types
-  (-> (List (Type Var)) (Check (List [(Type Var) .Type])))
-  (monad.each check.monad
-              (function (_ parameterJ)
-                (do check.monad
-                  [[_ parameterT] check.existential]
-                  (in [parameterJ parameterT])))))
-
 (def: (matched? [sub sub_method subJT] [super super_method superJT])
   (-> [(Type Class) Text (Type Method)] [(Type Class) Text (Type Method)] Bit)
   (and (# descriptor.equivalence = (jvm.descriptor super) (jvm.descriptor sub))
@@ -2445,10 +2449,10 @@
           ... jvm.boolean jvm.byte jvm.short jvm.int jvm.char
           _.iconst_0)))
 
-(def: (mock_return returnT)
+(def: (mock_return :return:)
   (-> (Type Return) (Bytecode Any))
-  (case (jvm.void? returnT)
-    {.#Right returnT}
+  (case (jvm.void? :return:)
+    {.#Right :return:}
     _.return
 
     {.#Left valueT}
@@ -2591,14 +2595,8 @@
                           (list#each (|>> {#Overriden_Method}) methods)))
          ... Necessary for reflection to work properly during analysis.
          _ (phase.lifted (# host execute mock))
-         
-         parameters (typeA.check (..parameter_types parameters))
-         .let [mapping (list#mix (function (_ [parameterJ parameterT] mapping)
-                                   (dictionary.has (parser.name parameterJ)
-                                                   parameterT
-                                                   mapping))
-                                 luxT.fresh
-                                 parameters)]
+
+         mapping (typeA.check (..class_mapping parameters))
          super_classT (typeA.check (luxT.check (luxT.class mapping) (..signature super_class)))
          super_interfaceT+ (typeA.check (monad.each check.monad
                                                     (|>> ..signature (luxT.check (luxT.class mapping)))
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux
index 27b3cf9d2..3374c4ba4 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux
@@ -167,7 +167,7 @@
           )))
 
 (type: Variable
-  [Text (Modifier field.Field) (Modifier field.Field) (List Annotation) (Type Value)])
+  [Text (Modifier field.Field) (Modifier field.Field) Bit (List Annotation) (Type Value)])
 
 (def: variable
   (Parser Variable)
@@ -177,6 +177,7 @@
           <code>.text
           ..visibility
           ..state
+          (<>.parses? (<code>.text! jvm.static_tag))
           (<code>.tuple (<>.some ..annotation))
           ..field_type
           )))
@@ -250,8 +251,13 @@
       (undefined))
 
     ... TODO: Handle annotations.
-    {#Variable [name visibility state annotations type]}
-    (field.field (modifier#composite visibility state)
+    {#Variable [name visibility state static? annotations type]}
+    (field.field ($_ modifier#composite
+                     (if static?
+                       field.static
+                       modifier.empty)
+                     visibility
+                     state)
                  name #1 type sequence.empty)))
 
 (def: annotation_parameter_synthesis
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux
index cb078ad43..4fbc7e603 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux
@@ -351,9 +351,19 @@
   [return Return parser.return]
   )
 
+(def: reflection
+  (All (_ category)
+    (-> (Type (<| Return' Value' category)) Text))
+  (|>> type.reflection reflection.reflection))
+
+(def: signature
+  (All (_ category)
+    (-> (Type category) Text))
+  (|>> type.signature signature.signature))
+
 (exception: .public (not_an_object_array [arrayJT (Type Array)])
   (exception.report
-   ["JVM Type" (|> arrayJT type.signature signature.signature)]))
+   ["JVM Type" (..signature arrayJT)]))
 
 (def: .public object_array
   (Parser (Type Object))
@@ -589,11 +599,6 @@
                 (_.instanceof (type.class class (list)))
                 (///value.wrap type.boolean)))))]))
 
-(def: reflection
-  (All (_ category)
-    (-> (Type (<| Return' Value' category)) Text))
-  (|>> type.reflection reflection.reflection))
-
 (def: object::cast
   Handler
   (..custom
@@ -601,32 +606,27 @@
     (function (_ extension_name generate archive [from to valueS])
       (do //////.monad
         [valueG (generate archive valueS)]
-        (in (`` (cond (~~ (template [<object> <type> <unwrap>]
-                            [(and (text#= (..reflection <type>)
-                                          from)
-                                  (text#= <object>
-                                          to))
-                             (let [$<object> (type.class <object> (list))]
-                               ($_ _.composite
-                                   valueG
-                                   (///value.wrap <type>)))
-
-                             (and (text#= <object>
-                                          from)
-                                  (text#= (..reflection <type>)
-                                          to))
+        (in (`` (cond (~~ (template [<object> <type>]
+                            [(and (text#= (..reflection <type>) from)
+                                  (text#= <object> to))
+                             ($_ _.composite
+                                 valueG
+                                 (///value.wrap <type>))
+
+                             (and (text#= <object> from)
+                                  (text#= (..reflection <type>) to))
                              ($_ _.composite
                                  valueG
                                  (///value.unwrap <type>))]
                             
-                            [box.boolean type.boolean "booleanValue"]
-                            [box.byte    type.byte    "byteValue"]
-                            [box.short   type.short   "shortValue"]
-                            [box.int     type.int     "intValue"]
-                            [box.long    type.long    "longValue"]
-                            [box.float   type.float   "floatValue"]
-                            [box.double  type.double  "doubleValue"]
-                            [box.char    type.char    "charValue"]))
+                            [box.boolean type.boolean]
+                            [box.byte    type.byte]
+                            [box.short   type.short]
+                            [box.int     type.int]
+                            [box.long    type.long]
+                            [box.char    type.char]
+                            [box.float   type.float]
+                            [box.double  type.double]))
                       ... else
                       valueG)))))]))
 
@@ -643,96 +643,68 @@
           (/////bundle.install "cast" object::cast)
           )))
 
-(def: primitives
-  (Dictionary Text (Type Primitive))
-  (|> (list [(reflection.reflection reflection.boolean) type.boolean]
-            [(reflection.reflection reflection.byte) type.byte]
-            [(reflection.reflection reflection.short) type.short]
-            [(reflection.reflection reflection.int) type.int]
-            [(reflection.reflection reflection.long) type.long]
-            [(reflection.reflection reflection.float) type.float]
-            [(reflection.reflection reflection.double) type.double]
-            [(reflection.reflection reflection.char) type.char])
-      (dictionary.of_list text.hash)))
-
 (def: get::static
   Handler
   (..custom
-   [($_ <>.and <synthesis>.text <synthesis>.text <synthesis>.text)
-    (function (_ extension_name generate archive [class field unboxed])
-      (do //////.monad
-        [.let [$class (type.class class (list))]]
-        (case (dictionary.value unboxed ..primitives)
-          {.#Some primitive}
-          (in (_.getstatic $class field primitive))
-          
-          {.#None}
-          (in (_.getstatic $class field (type.class unboxed (list)))))))]))
+   [($_ <>.and <synthesis>.text <synthesis>.text ..value)
+    (function (_ extension_name generate archive [class field :unboxed:])
+      (# //////.monad in (_.getstatic (type.class class (list)) field :unboxed:)))]))
 
-(def: unitG (_.string //////synthesis.unit))
+(def: unitG
+  (_.string //////synthesis.unit))
 
 (def: put::static
   Handler
   (..custom
-   [($_ <>.and <synthesis>.text <synthesis>.text <synthesis>.text <synthesis>.any)
-    (function (_ extension_name generate archive [class field unboxed valueS])
+   [($_ <>.and <synthesis>.text <synthesis>.text ..value <synthesis>.any)
+    (function (_ extension_name generate archive [class field :unboxed: valueS])
       (do //////.monad
-        [valueG (generate archive valueS)
-         .let [$class (type.class class (list))]]
-        (case (dictionary.value unboxed ..primitives)
-          {.#Some primitive}
-          (in ($_ _.composite
-                  valueG
-                  (_.putstatic $class field primitive)
-                  ..unitG))
-          
-          {.#None}
-          (in ($_ _.composite
-                  valueG
-                  (_.checkcast $class)
-                  (_.putstatic $class field $class)
-                  ..unitG)))))]))
+        [valueG (generate archive valueS)]
+        (in ($_ _.composite
+                valueG
+                (case (parser.object? :unboxed:)
+                  {.#Some :unboxed:}
+                  (_.checkcast :unboxed:)
+                  
+                  {.#None}
+                  (_#in []))
+                (_.putstatic (type.class class (list)) field :unboxed:)
+                ..unitG))))]))
 
 (def: get::virtual
   Handler
   (..custom
-   [($_ <>.and <synthesis>.text <synthesis>.text <synthesis>.text <synthesis>.any)
-    (function (_ extension_name generate archive [class field unboxed objectS])
+   [($_ <>.and <synthesis>.text <synthesis>.text ..value <synthesis>.any)
+    (function (_ extension_name generate archive [class field :unboxed: objectS])
       (do //////.monad
         [objectG (generate archive objectS)
-         .let [$class (type.class class (list))
-               getG (case (dictionary.value unboxed ..primitives)
-                      {.#Some primitive}
-                      (_.getfield $class field primitive)
-                      
-                      {.#None}
-                      (_.getfield $class field (type.class unboxed (list))))]]
+         .let [:class: (type.class class (list))
+               getG (_.getfield :class: field :unboxed:)]]
         (in ($_ _.composite
                 objectG
-                (_.checkcast $class)
+                (_.checkcast :class:)
                 getG))))]))
 
 (def: put::virtual
   Handler
   (..custom
-   [($_ <>.and <synthesis>.text <synthesis>.text <synthesis>.text <synthesis>.any <synthesis>.any)
-    (function (_ extension_name generate archive [class field unboxed valueS objectS])
+   [($_ <>.and <synthesis>.text <synthesis>.text ..value <synthesis>.any <synthesis>.any)
+    (function (_ extension_name generate archive [class field :unboxed: valueS objectS])
       (do //////.monad
         [valueG (generate archive valueS)
          objectG (generate archive objectS)
-         .let [$class (type.class class (list))
-               putG (case (dictionary.value unboxed ..primitives)
-                      {.#Some primitive}
-                      (_.putfield $class field primitive)
+         .let [:class: (type.class class (list))
+               putG (case (parser.object? :unboxed:)
+                      {.#Some :unboxed:}
+                      ($_ _.composite
+                          (_.checkcast :unboxed:)
+                          (_.putfield :class: field :unboxed:))
                       
                       {.#None}
-                      (let [$unboxed (type.class unboxed (list))]
-                        ($_ _.composite
-                            (_.checkcast $unboxed)
-                            (_.putfield $class field $unboxed))))]]
+                      (_.putfield :class: field :unboxed:))]]
         (in ($_ _.composite
                 objectG
-                (_.checkcast $class)
+                (_.checkcast :class:)
                 _.dup
                 valueG
                 putG))))]))
@@ -764,7 +736,7 @@
     ..unitG
     
     {.#Left outputT}
-    (# _.monad in [])))
+    (_#in [])))
 
 (def: invoke::static
   Handler
diff --git a/stdlib/source/library/lux/tool/compiler/meta/packager.lux b/stdlib/source/library/lux/tool/compiler/meta/packager.lux
index 51f9069d0..5b0bd0438 100644
--- a/stdlib/source/library/lux/tool/compiler/meta/packager.lux
+++ b/stdlib/source/library/lux/tool/compiler/meta/packager.lux
@@ -26,7 +26,7 @@
 (type: .public Packager
   (-> (Dictionary file.Path Binary)
       Archive
-      unit.ID
+      (Maybe unit.ID)
       (Try (Either Binary
                    (List [Text Binary])))))
 
diff --git a/stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux b/stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux
index 9b84fa64d..99c9a316b 100644
--- a/stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux
+++ b/stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux
@@ -131,11 +131,18 @@
   "1.0")
 
 (def: (manifest program)
-  (-> unit.ID java/util/jar/Manifest)
-  (let [manifest (java/util/jar/Manifest::new)]
-    (exec (do_to (java/util/jar/Manifest::getMainAttributes manifest)
-            (java/util/jar/Attributes::put (java/util/jar/Attributes$Name::MAIN_CLASS) (|> program runtime.class_name name.internal name.external))
-            (java/util/jar/Attributes::put (java/util/jar/Attributes$Name::MANIFEST_VERSION) ..manifest_version))
+  (-> (Maybe unit.ID) java/util/jar/Manifest)
+  (let [manifest (java/util/jar/Manifest::new)
+        attrs (do_to (java/util/jar/Manifest::getMainAttributes manifest)
+                (java/util/jar/Attributes::put (java/util/jar/Attributes$Name::MANIFEST_VERSION) ..manifest_version))]
+    (exec
+      (case program
+        {.#Some program}
+        (do_to attrs
+          (java/util/jar/Attributes::put (java/util/jar/Attributes$Name::MAIN_CLASS) (|> program runtime.class_name name.internal name.external)))
+        
+        {.#None}
+        attrs)
       manifest)))
 
 (def: (write_class static module artifact custom content sink)