Fixes for the pure-Lux JVM compiler machinery. [Part 9]

13 files changed, 149 insertions, 102 deletions

diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/analysis.lux b/stdlib/source/library/lux/tool/compiler/language/lux/analysis.lux
index 0f1d59581..643a1b428 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/analysis.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis.lux
@@ -1,6 +1,6 @@
 (.using
  [library
-  [lux {"-" Tuple Variant nat int rev case}
+  [lux {"-" Tuple Variant nat int rev case local}
    [abstract
     [equivalence {"+" Equivalence}]
     [hash {"+" Hash}]
@@ -138,7 +138,7 @@
 (type: .public (Abstraction c)
   [(Environment c) Arity c])
 
-(type: .public (Application c)
+(type: .public (Reification c)
   [c (List c)])
 
 (template: .public (no_op value)
@@ -149,15 +149,15 @@
        {..#Function (list)}
        {..#Apply value})])
 
-(def: .public (apply [abstraction inputs])
-  (-> (Application Analysis) Analysis)
+(def: .public (reified [abstraction inputs])
+  (-> (Reification Analysis) Analysis)
   (list#mix (function (_ input abstraction')
               {#Apply input abstraction'})
             abstraction
             inputs))
 
-(def: .public (application analysis)
-  (-> Analysis (Application Analysis))
+(def: .public (reification analysis)
+  (-> Analysis (Reification Analysis))
   (loop [abstraction analysis
          inputs (list)]
     (.case abstraction
@@ -173,11 +173,11 @@
                        <tag>
                        (~ content))))))]
 
-  [variable         {reference.#Variable}]
-  [constant         {reference.#Constant}]
+  [variable {reference.#Variable}]
+  [constant {reference.#Constant}]
 
-  [variable/local   ((~! reference.local))]
-  [variable/foreign ((~! reference.foreign))]
+  [local    ((~! reference.local))]
+  [foreign  ((~! reference.foreign))]
   )
 
 (template [<name> <tag>]
@@ -223,7 +223,7 @@
     
     {#Apply _}
     (|> analysis
-        ..application
+        ..reification
         {.#Item}
         (list#each format)
         (text.interposed " ")
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis.lux
index 9db69a2c3..fb64abaf3 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis.lux
@@ -17,7 +17,7 @@
     ["[0]" location]]]]
  ["[0]" / "_"
   ["[1][0]" type]
-  ["[1][0]" primitive]
+  ["[1][0]" simple]
   ["[1][0]" structure]
   ["[1][0]" reference]
   ["[1][0]" case]
@@ -49,12 +49,12 @@
     (^template [<tag> <analyser>]
       [{<tag> value}
        (<analyser> value)])
-    ([.#Bit  /primitive.bit]
-     [.#Nat  /primitive.nat]
-     [.#Int  /primitive.int]
-     [.#Rev  /primitive.rev]
-     [.#Frac /primitive.frac]
-     [.#Text /primitive.text])
+    ([.#Bit  /simple.bit]
+     [.#Nat  /simple.nat]
+     [.#Int  /simple.int]
+     [.#Rev  /simple.rev]
+     [.#Frac /simple.frac]
+     [.#Text /simple.text])
 
     (^ {.#Variant (list& [_ {.#Symbol tag}]
                          values)})
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/function.lux
index 4bca170c3..1b4b38a7c 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/function.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/function.lux
@@ -1,31 +1,31 @@
 (.using
-  [library
-   [lux {"-" function}
-    [abstract
-     monad]
-    [control
-     ["[0]" maybe]
-     ["ex" exception {"+" exception:}]]
-    [data
-     ["[0]" text
-      ["%" format {"+" format}]]
-     [collection
-      ["[0]" list ("[1]#[0]" monoid monad)]]]
-    ["[0]" type
-     ["[0]" check]]
-    ["[0]" meta]]]
-  ["[0]" // "_"
-   ["[1][0]" scope]
-   ["[1][0]" type]
-   ["[1][0]" inference]
-   ["/[1]" // "_"
-    ["[1][0]" extension]
-    [//
-     ["/" analysis {"+" Analysis Operation Phase}]
-     [///
-      ["[1]" phase]
-      [reference {"+"}
-       [variable {"+"}]]]]]])
+ [library
+  [lux {"-" function}
+   [abstract
+    monad]
+   [control
+    ["[0]" maybe]
+    ["ex" exception {"+" exception:}]]
+   [data
+    ["[0]" text
+     ["%" format {"+" format}]]
+    [collection
+     ["[0]" list ("[1]#[0]" monoid monad)]]]
+   ["[0]" type
+    ["[0]" check]]
+   ["[0]" meta]]]
+ ["[0]" // "_"
+  ["[1][0]" scope]
+  ["[1][0]" type]
+  ["[1][0]" inference]
+  ["/[1]" // "_"
+   ["[1][0]" extension]
+   [//
+    ["/" analysis {"+" Analysis Operation Phase}]
+    [///
+     ["[1]" phase]
+     [reference {"+"}
+      [variable {"+"}]]]]]])
 
 (exception: .public (cannot_analyse [expected Type
                                      function Text
@@ -114,4 +114,4 @@
   (<| (/.with_stack ..cannot_apply [functionT functionC argsC+])
       (do ///.monad
         [[applyT argsA+] (//inference.general archive analyse functionT argsC+)])
-      (in (/.apply [functionA argsA+]))))
+      (in (/.reified [functionA argsA+]))))
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/primitive.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/simple.lux
index 69984ab22..7d65b62cf 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/primitive.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/simple.lux
@@ -2,7 +2,7 @@
  [library
   [lux {"-" nat int rev}
    [abstract
-    monad]]]
+    [monad {"+" do}]]]]
  ["[0]" // "_"
   ["[1][0]" type]
   ["/[1]" // "_"
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/structure.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/structure.lux
index bcc0a82fe..12f00a8aa 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/structure.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/structure.lux
@@ -27,7 +27,7 @@
      ["[0]" check]]]]
   ["[0]" // "_"
    ["[1][0]" type]
-   ["[1][0]" primitive]
+   ["[1][0]" simple]
    ["[1][0]" inference]
    ["/[1]" // "_"
     ["[1][0]" extension]
@@ -398,7 +398,7 @@
   (-> Archive Phase (List Code) (Operation Analysis))
   (case members
     (^ (list))
-    //primitive.unit
+    //simple.unit
 
     (^ (list singletonC))
     (analyse archive singletonC)
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 1e6c6af8e..0f076e04a 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
@@ -21,6 +21,8 @@
      ["[0]" list ("[1]#[0]" mix monad monoid)]
      ["[0]" array]
      ["[0]" dictionary {"+" Dictionary}]]]
+   [macro
+    ["[0]" template]]
    [math
     [number
      ["n" nat]]]
@@ -89,9 +91,13 @@
    (getDeclaringClass [] (java/lang/Class java/lang/Object))
    (getTypeParameters [] [(java/lang/reflect/TypeVariable java/lang/reflect/Method)])
    (getGenericParameterTypes [] [java/lang/reflect/Type])
-   (getGenericReturnType [] java/lang/reflect/Type)
-   (getGenericExceptionTypes [] [java/lang/reflect/Type])
-   (getDeclaredAnnotations [] [java/lang/annotation/Annotation])])
+   (getDeclaredAnnotations [] [java/lang/annotation/Annotation])
+   
+   (getReturnType [] (java/lang/Class java/lang/Object))
+   (getGenericReturnType [] "?" java/lang/reflect/Type)
+   
+   (getExceptionTypes [] [(java/lang/Class java/lang/Object)])
+   (getGenericExceptionTypes [] [java/lang/reflect/Type])])
 
 (import: (java/lang/reflect/Constructor c)
   ["[1]::[0]"
@@ -99,6 +105,7 @@
    (getDeclaringClass [] (java/lang/Class c))
    (getTypeParameters [] [(java/lang/reflect/TypeVariable (java/lang/reflect/Constructor c))])
    (getGenericParameterTypes [] [java/lang/reflect/Type])
+   (getExceptionTypes [] [(java/lang/Class java/lang/Object)])
    (getGenericExceptionTypes [] [java/lang/reflect/Type])
    (getDeclaredAnnotations [] [java/lang/annotation/Annotation])])
 
@@ -1183,6 +1190,31 @@
         mapping (dictionary.of_list text.hash lux_tvars)]
     [owner_tvarsT mapping]))
 
+(def: (lux_class it)
+  (-> (java/lang/Class java/lang/Object) (Type Class))
+  (jvm.class (java/lang/Class::getName it) (list)))
+
+(template [<name> <type> <params>]
+  [(`` (def: <name>
+         (-> (<type> (~~ (template.spliced <params>))) (List (Type Class)))
+         (|>> (~~ (template.symbol [<type> "::getExceptionTypes"]))
+              (array.list {.#None})
+              (list#each ..lux_class))))]
+
+  [concrete_method_exceptions java/lang/reflect/Method []]
+  [concrete_constructor_exceptions java/lang/reflect/Constructor [java/lang/Object]]
+  )
+
+(def: (return_type it)
+  (-> java/lang/reflect/Method (Try (Type Return)))
+  (reflection!.return
+   (case (java/lang/reflect/Method::getGenericReturnType it)
+     {.#Some it}
+     it
+     
+     {.#None}
+     (java/lang/reflect/Method::getReturnType it))))
+
 (def: (method_signature method_style method)
   (-> Method_Style java/lang/reflect/Method (Operation Method_Signature))
   (let [owner (java/lang/reflect/Method::getDeclaringClass method)
@@ -1205,16 +1237,17 @@
                    (phase#each (monad.each ! (..reflection_type mapping)))
                    phase#conjoint)
        outputT (|> method
-                   java/lang/reflect/Method::getGenericReturnType
-                   reflection!.return
+                   ..return_type
                    phase.lifted
                    (phase#each (..reflection_return mapping))
                    phase#conjoint)
-       exceptionsT (|> (java/lang/reflect/Method::getGenericExceptionTypes method)
-                       (array.list {.#None})
-                       (monad.each ! (|>> reflection!.type phase.lifted))
-                       (phase#each (monad.each ! (..reflection_type mapping)))
-                       phase#conjoint)
+       .let [concrete_exceptions (..concrete_method_exceptions method)]
+       concrete_exceptions (monad.each ! (..reflection_type mapping) concrete_exceptions)
+       generic_exceptions (|> (java/lang/reflect/Method::getGenericExceptionTypes method)
+                              (array.list {.#None})
+                              (monad.each ! (|>> reflection!.type phase.lifted))
+                              (phase#each (monad.each ! (..reflection_type mapping)))
+                              phase#conjoint)
        .let [methodT (<| (type.univ_q (dictionary.size mapping))
                          (type.function (case method_style
                                           {#Static}
@@ -1226,7 +1259,9 @@
                          outputT)]]
       (in [methodT
            (reflection!.deprecated? (java/lang/reflect/Method::getDeclaredAnnotations method))
-           exceptionsT]))))
+           (if (list.empty? generic_exceptions)
+             concrete_exceptions
+             generic_exceptions)]))))
 
 (def: (constructor_signature constructor)
   (-> (java/lang/reflect/Constructor java/lang/Object) (Operation Method_Signature))
@@ -1244,18 +1279,22 @@
                    (monad.each ! (|>> reflection!.type phase.lifted))
                    (phase#each (monad.each ! (reflection_type mapping)))
                    phase#conjoint)
-       exceptionsT (|> (java/lang/reflect/Constructor::getGenericExceptionTypes constructor)
-                       (array.list {.#None})
-                       (monad.each ! (|>> reflection!.type phase.lifted))
-                       (phase#each (monad.each ! (reflection_type mapping)))
-                       phase#conjoint)
+       .let [concrete_exceptions (..concrete_constructor_exceptions constructor)]
+       concrete_exceptions (monad.each ! (..reflection_type mapping) concrete_exceptions)
+       generic_exceptions (|> (java/lang/reflect/Constructor::getGenericExceptionTypes constructor)
+                              (array.list {.#None})
+                              (monad.each ! (|>> reflection!.type phase.lifted))
+                              (phase#each (monad.each ! (reflection_type mapping)))
+                              phase#conjoint)
        .let [objectT {.#Primitive (java/lang/Class::getName owner) owner_tvarsT}
              constructorT (<| (type.univ_q (dictionary.size mapping))
                               (type.function inputsT)
                               objectT)]]
       (in [constructorT
            (reflection!.deprecated? (java/lang/reflect/Constructor::getDeclaredAnnotations constructor))
-           exceptionsT]))))
+           (if (list.empty? generic_exceptions)
+             concrete_exceptions
+             generic_exceptions)]))))
 
 (type: Evaluation
   (Variant
@@ -1572,14 +1611,15 @@
                            inputs (|> (java/lang/reflect/Method::getGenericParameterTypes method)
                                       (array.list {.#None})
                                       (monad.each ! reflection!.type))
-                           return (|> method
-                                      java/lang/reflect/Method::getGenericReturnType
-                                      reflection!.return)
-                           exceptions (|> (java/lang/reflect/Method::getGenericExceptionTypes method)
-                                          (array.list {.#None})
-                                          (monad.each ! reflection!.class))]
+                           return (..return_type method)
+                           .let [concrete_exceptions (..concrete_method_exceptions method)]
+                           generic_exceptions (|> (java/lang/reflect/Method::getGenericExceptionTypes method)
+                                                  (array.list {.#None})
+                                                  (monad.each ! reflection!.class))]
                           (in [(java/lang/reflect/Method::getName method)
-                               (jvm.method [type_variables inputs return exceptions])]))))))]
+                               (jvm.method [type_variables inputs return (if (list.empty? generic_exceptions)
+                                                                           concrete_exceptions
+                                                                           generic_exceptions)])]))))))]
 
   [abstract_methods (list.only (|>> java/lang/reflect/Method::getModifiers java/lang/reflect/Modifier::isAbstract))]
   [methods (<|)]
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 5442fafdb..72f978083 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
@@ -351,6 +351,7 @@
                                         class.abstract
                                         class.interface)
                                     (name.internal name)
+                                    (type.declaration name parameters)
                                     (name.internal "java.lang.Object")
                                     (list#each (|>> parser.read_class product.left name.internal)
                                                supers)
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 9f461699f..7a3c93014 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
@@ -1224,6 +1224,7 @@
                       //////.lifted
                       (class.class version.v6_0 ($_ modifier#composite class.public class.final)
                                    (name.internal anonymous_class_name)
+                                   (type.declaration anonymous_class_name (list))
                                    (name.internal (..reflection super_class))
                                    (list#each (|>> ..reflection name.internal) super_interfaces)
                                    (foreign.variables total_environment)
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux
index 343aa7f1f..357337927 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux
@@ -110,6 +110,7 @@
      class (phase.lifted (class.class version.v6_0
                                       ..modifier
                                       (name.internal function_class)
+                                      (type.declaration function_class (list))
                                       (..internal /abstract.class) (list)
                                       fields
                                       methods
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/host.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/host.lux
index b15832011..79c72c425 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/host.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/host.lux
@@ -122,6 +122,7 @@
         bytecode (class.class version.v6_0
                               class.public
                               (encoding/name.internal bytecode_name)
+                              (type.declaration bytecode_name (list))
                               (encoding/name.internal "java.lang.Object") (list)
                               (list (field.field ..value::modifier ..value::field ..value::type (sequence.sequence)))
                               (list (method.method ..init::modifier "<clinit>" ..init::type
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/program.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/program.lux
index d8ab2d2d6..bf0bb032d 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/program.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/program.lux
@@ -157,6 +157,7 @@
          (class.class version.v6_0
                       ..program::modifier
                       (name.internal class)
+                      (type.declaration class (list))
                       super_class
                       (list)
                       (list)
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux
index e9f88652c..74956a7e5 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux
@@ -545,6 +545,7 @@
                      (class.class jvm/version.v6_0
                                   modifier
                                   (name.internal class)
+                                  (type.declaration class (list))
                                   (name.internal (..reflection ^Object)) (list)
                                   (list)
                                   (let [[left_projection::method right_projection::method] projection::method2]
@@ -614,6 +615,7 @@
                      (class.class jvm/version.v6_0
                                   modifier
                                   (name.internal class)
+                                  (type.declaration class (list))
                                   (name.internal (..reflection ^Object)) (list)
                                   (list partial_count)
                                   (list& <init>::method apply::method+)
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/function.lux
index d7fa84bfd..d6fe2a3ea 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/function.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/function.lux
@@ -1,32 +1,32 @@
 (.using
-  [library
-   [lux "*"
-    [abstract
-     ["[0]" monad {"+" do}]
-     ["[0]" enum]]
-    [control
-     [pipe {"+" case>}]
-     ["[0]" maybe ("[1]#[0]" functor)]
-     ["[0]" exception {"+" exception:}]]
-    [data
-     ["[0]" text
-      ["%" format {"+" format}]]
-     [collection
-      ["[0]" list ("[1]#[0]" functor monoid)]]]
-    [math
-     [number
-      ["n" nat]]]]]
-  ["[0]" // "_"
-   ["[1][0]" loop {"+" Transform}]
-   ["//[1]" /// "_"
-    ["[1][0]" analysis {"+" Environment Analysis}
-     ["[1]/[0]" complex]]
-    ["/" synthesis {"+" Path Abstraction Synthesis Operation Phase}]
-    [///
-     [arity {"+" Arity}]
-     ["[1][0]" reference
-      ["[1]/[0]" variable {"+" Register Variable}]]
-     ["[0]" phase ("[1]#[0]" monad)]]]])
+ [library
+  [lux "*"
+   [abstract
+    ["[0]" monad {"+" do}]
+    ["[0]" enum]]
+   [control
+    [pipe {"+" case>}]
+    ["[0]" maybe ("[1]#[0]" functor)]
+    ["[0]" exception {"+" exception:}]]
+   [data
+    ["[0]" text
+     ["%" format {"+" format}]]
+    [collection
+     ["[0]" list ("[1]#[0]" functor monoid)]]]
+   [math
+    [number
+     ["n" nat]]]]]
+ ["[0]" // "_"
+  ["[1][0]" loop {"+" Transform}]
+  ["//[1]" /// "_"
+   ["[1][0]" analysis {"+" Environment Analysis}
+    ["[1]/[0]" complex]]
+   ["/" synthesis {"+" Path Abstraction Synthesis Operation Phase}]
+   [///
+    [arity {"+" Arity}]
+    ["[1][0]" reference
+     ["[1]/[0]" variable {"+" Register Variable}]]
+    ["[0]" phase ("[1]#[0]" monad)]]]])
 
 (exception: .public (cannot_find_foreign_variable_in_environment [foreign Register
                                                                   environment (Environment Synthesis)])
@@ -50,7 +50,7 @@
 (def: .public (apply phase)
   (-> Phase Phase)
   (function (_ archive exprA)
-    (let [[funcA argsA] (////analysis.application exprA)]
+    (let [[funcA argsA] (////analysis.reification exprA)]
       (do [! phase.monad]
         [funcS (phase archive funcA)
          argsS (monad.each ! (phase archive) argsA)]