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

7 files changed, 245 insertions, 168 deletions

diff --git a/stdlib/source/test/lux/control/parser/analysis.lux b/stdlib/source/test/lux/control/parser/analysis.lux
index 7caae5fdd..a3f401643 100644
--- a/stdlib/source/test/lux/control/parser/analysis.lux
+++ b/stdlib/source/test/lux/control/parser/analysis.lux
@@ -87,8 +87,8 @@
                       [/.frac /.frac! random.safe_frac analysis.frac f.=]
                       [/.rev /.rev! random.rev analysis.rev r.=]
                       [/.text /.text! (random.unicode 10) analysis.text text#=]
-                      [/.local /.local! random.nat analysis.variable/local n.=]
-                      [/.foreign /.foreign! random.nat analysis.variable/foreign n.=]
+                      [/.local /.local! random.nat analysis.local n.=]
+                      [/.foreign /.foreign! random.nat analysis.foreign n.=]
                       [/.constant /.constant! ..constant analysis.constant symbol#=]
                       ))
                 (do [! random.monad]
diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux
index 3a10b530d..62ef895da 100644
--- a/stdlib/source/test/lux/target/jvm.lux
+++ b/stdlib/source/test/lux/target/jvm.lux
@@ -110,6 +110,7 @@
     (in (case (do try.monad
                 [class (/class.class /version.v6_0 /class.public
                                      (/name.internal class_name)
+                                     (/type.declaration class_name (list))
                                      (/name.internal "java.lang.Object")
                                      (list)
                                      (list)
@@ -853,6 +854,7 @@
            static_method "static_method"
            bytecode (|> (/class.class /version.v6_0 /class.public
                                       (/name.internal class_name)
+                                      (/type.declaration class_name (list))
                                       (/name.internal "java.lang.Object")
                                       (list)
                                       (list (/field.field /field.static class_field /type.long (sequence.sequence))
@@ -1330,6 +1332,7 @@
                                 (in (case (do try.monad
                                             [class (/class.class /version.v6_0 /class.public
                                                                  (/name.internal class_name)
+                                                                 (/type.declaration class_name (list))
                                                                  (/name.internal "java.lang.Object")
                                                                  (list)
                                                                  (list)
@@ -1629,6 +1632,7 @@
 
            interface_bytecode (|> (/class.class /version.v6_0 ($_ /modifier#composite /class.public /class.abstract /class.interface)
                                                 (/name.internal interface_class)
+                                                (/type.declaration interface_class (list))
                                                 (/name.internal "java.lang.Object")
                                                 (list)
                                                 (list)
@@ -1639,6 +1643,7 @@
                                   (format.result /class.writer))
            abstract_bytecode (|> (/class.class /version.v6_0 ($_ /modifier#composite /class.public /class.abstract)
                                                (/name.internal abstract_class)
+                                               (/type.declaration abstract_class (list))
                                                (/name.internal "java.lang.Object")
                                                (list)
                                                (list)
@@ -1664,6 +1669,7 @@
                          (/.invokevirtual class method method::type))))
            concrete_bytecode (|> (/class.class /version.v6_0 /class.public
                                                (/name.internal concrete_class)
+                                               (/type.declaration concrete_class (list))
                                                (/name.internal abstract_class)
                                                (list (/name.internal interface_class))
                                                (list)
diff --git a/stdlib/source/test/lux/target/ruby.lux b/stdlib/source/test/lux/target/ruby.lux
index 2a2f9667d..516037ea9 100644
--- a/stdlib/source/test/lux/target/ruby.lux
+++ b/stdlib/source/test/lux/target/ruby.lux
@@ -3,6 +3,7 @@
   [lux "*"
    ["_" test {"+" Test}]
    ["[0]" ffi]
+   ["[0]" debug]
    [abstract
     [monad {"+" do}]
     ["[0]" predicate]
@@ -340,12 +341,103 @@
                    ..test|computation)
             ))))
 
-(def: test/location
+(def: test|local_var
+  Test
+  (do [! random.monad]
+    [float/0 random.safe_frac
+     $foreign (# ! each /.local (random.ascii/lower 10))]
+    ($_ _.and
+        (_.cover [/.local]
+                 (expression (|>> (:as Frac) (f.= (f.+ float/0 float/0)))
+                             (|> (/.return (/.+ $foreign $foreign))
+                                 [(list $foreign)] (/.lambda {.#None})
+                                 (/.apply_lambda/* (list (/.float float/0))))))
+        (_.cover [/.set]
+                 (expression (|>> (:as Frac) (f.= (f.+ float/0 float/0)))
+                             (|> ($_ /.then
+                                     (/.set (list $foreign) (/.float float/0))
+                                     (/.return (/.+ $foreign $foreign)))
+                                 [(list)] (/.lambda {.#None})
+                                 (/.apply_lambda/* (list)))))
+        )))
+
+(def: test|instance_var
+  Test
+  (do [! random.monad]
+    [float/0 random.safe_frac
+     instance (# ! each (|>> %.nat (format "instance_"))
+                 random.nat)
+     .let [$instance (/.instance instance)]
+     $method (# ! each (|>> %.nat (format "method_") /.local)
+                random.nat)
+     $class (# ! each (|>> %.nat (format "class_") /.local)
+               random.nat)
+     $object (# ! each (|>> %.nat (format "object_") /.local)
+                random.nat)]
+    ($_ _.and
+        (_.cover [/.instance]
+                 (expression (|>> (:as Frac) (f.= float/0))
+                             (|> ($_ /.then
+                                     (/.set (list $class) (/.class [/.#parameters (list)
+                                                                    /.#body ($_ /.then
+                                                                                (/.function /.initialize (list)
+                                                                                  (/.set (list $instance) (/.float float/0)))
+                                                                                (/.function $method (list)
+                                                                                  (/.return $instance))
+                                                                                )]))
+                                     (/.return (|> $class
+                                                   (/.new (list) {.#None})
+                                                   (/.do (/.code $method) (list) {.#None}))))
+                                 [(list)] (/.lambda {.#None})
+                                 (/.apply_lambda/* (list)))))
+        (_.cover [/.attr_reader/*]
+                 (expression (|>> (:as Frac) (f.= float/0))
+                             (|> ($_ /.then
+                                     (/.set (list $class) (/.class [/.#parameters (list)
+                                                                    /.#body ($_ /.then
+                                                                                (/.attr_reader/* (list instance))
+                                                                                (/.function /.initialize (list)
+                                                                                  (/.set (list $instance) (/.float float/0)))
+                                                                                )]))
+                                     (/.return (|> $class
+                                                   (/.new (list) {.#None})
+                                                   (/.the instance))))
+                                 [(list)] (/.lambda {.#None})
+                                 (/.apply_lambda/* (list)))))
+        (_.cover [/.attr_writer/*]
+                 (expression (|>> (:as Frac) (f.= float/0))
+                             (|> ($_ /.then
+                                     (/.set (list $class) (/.class [/.#parameters (list)
+                                                                    /.#body ($_ /.then
+                                                                                (/.attr_writer/* (list instance))
+                                                                                (/.function $method (list)
+                                                                                  (/.return $instance))
+                                                                                )]))
+                                     (/.set (list $object) (|> $class
+                                                               (/.new (list) {.#None})))
+                                     (/.set (list (/.the instance $object)) (/.float float/0))
+                                     (/.return (|>  $object
+                                                    (/.do (/.code $method) (list) {.#None}))))
+                                 [(list)] (/.lambda {.#None})
+                                 (/.apply_lambda/* (list)))))
+        (_.cover [/.attr_accessor/*]
+                 (expression (|>> (:as Frac) (f.= float/0))
+                             (|> ($_ /.then
+                                     (/.set (list $class) (/.class [/.#parameters (list)
+                                                                    /.#body (/.attr_accessor/* (list instance))]))
+                                     (/.set (list $object) (|> $class
+                                                               (/.new (list) {.#None})))
+                                     (/.set (list (/.the instance $object)) (/.float float/0))
+                                     (/.return (/.the instance $object)))
+                                 [(list)] (/.lambda {.#None})
+                                 (/.apply_lambda/* (list)))))
+        )))
+
+(def: test|var
   Test
   (do [! random.monad]
     [float/0 random.safe_frac
      $foreign (# ! each /.local (random.ascii/lower 10))
-     field (# ! each /.string (random.ascii/upper 10))
 
      $inputs (# ! each /.local (random.ascii/lower 10))
      arity (# ! each (n.% 10) random.nat)
@@ -356,44 +448,49 @@
               (random.set text.hash arity)
               (# ! each (|>> set.list (list#each /.string))))]
     ($_ _.and
-        (<| (_.for [/.Var])
+        (_.cover [/.defined?/1]
+                 (and (expression (|>> (:as Bit))
+                                  (|> (/.defined?/1 $foreign)
+                                      (/.= /.nil)))
+                      (expression (|>> (:as Text) (text#= "local-variable"))
+                                  (|> ($_ /.then
+                                          (/.set (list $foreign) (/.float float/0))
+                                          (/.return (/.defined?/1 $foreign)))
+                                      [(list)] (/.lambda {.#None})
+                                      (/.apply_lambda/* (list))))))
+        (_.for [/.LVar]
+               ..test|local_var)
+        (_.for [/.IVar]
+               ..test|instance_var)
+        (<| (_.for [/.LVar*])
             ($_ _.and
-                (_.cover [/.defined?/1]
-                         (and (expression (|>> (:as Bit))
-                                          (|> (/.defined?/1 $foreign)
-                                              (/.= /.nil)))
-                              (expression (|>> (:as Text) (text#= "local-variable"))
-                                          (|> ($_ /.then
-                                                  (/.set (list $foreign) (/.float float/0))
-                                                  (/.return (/.defined?/1 $foreign)))
-                                              [(list)] (/.lambda {.#None})
-                                              (/.apply_lambda/* (list))))))
-                (_.cover [/.LVar /.local /.set]
-                         (expression (|>> (:as Frac) (f.= (f.+ float/0 float/0)))
-                                     (|> ($_ /.then
-                                             (/.set (list $foreign) (/.+ $foreign $foreign))
-                                             (/.return $foreign))
-                                         [(list $foreign)] (/.lambda {.#None})
-                                         (/.apply_lambda/* (list (/.float float/0))))))
-                (<| (_.for [/.LVar*])
-                    ($_ _.and
-                        (_.cover [/.variadic]
-                                 (expression (|>> (:as Int) .nat (n.= arity))
-                                             (|> (/.return (/.the "length" $inputs))
-                                                 [(list (/.variadic $inputs))] (/.lambda {.#None})
-                                                 (/.apply_lambda/* vals))))
-                        (_.cover [/.splat]
-                                 (expression (|>> (:as Int) .nat (n.= arity))
-                                             (|> (/.return (/.the "length" (/.array (list (/.splat $inputs)))))
-                                                 [(list (/.variadic $inputs))] (/.lambda {.#None})
-                                                 (/.apply_lambda/* vals))))))
-                (<| (_.for [/.LVar**])
-                    (_.cover [/.variadic_kv /.double_splat]
-                             (expression (|>> (:as Int) .nat (n.= arity))
-                                         (|> (/.return (/.the "length" $inputs))
-                                             [(list (/.variadic_kv $inputs))] (/.lambda {.#None})
-                                             (/.apply_lambda/* (list (/.double_splat (/.hash (list.zipped/2 keys vals)))))))))
-                ))
+                (_.cover [/.variadic]
+                         (expression (|>> (:as Int) .nat (n.= arity))
+                                     (|> (/.return (/.the "length" $inputs))
+                                         [(list (/.variadic $inputs))] (/.lambda {.#None})
+                                         (/.apply_lambda/* vals))))
+                (_.cover [/.splat]
+                         (expression (|>> (:as Int) .nat (n.= arity))
+                                     (|> (/.return (/.the "length" (/.array (list (/.splat $inputs)))))
+                                         [(list (/.variadic $inputs))] (/.lambda {.#None})
+                                         (/.apply_lambda/* vals))))))
+        (<| (_.for [/.LVar**])
+            (_.cover [/.variadic_kv /.double_splat]
+                     (expression (|>> (:as Int) .nat (n.= arity))
+                                 (|> (/.return (/.the "length" $inputs))
+                                     [(list (/.variadic_kv $inputs))] (/.lambda {.#None})
+                                     (/.apply_lambda/* (list (/.double_splat (/.hash (list.zipped/2 keys vals)))))))))
+        )))
+
+(def: test|location
+  Test
+  (do [! random.monad]
+    [float/0 random.safe_frac
+     $foreign (# ! each /.local (random.ascii/lower 10))
+     field (# ! each /.string (random.ascii/upper 10))]
+    ($_ _.and
+        (<| (_.for [/.Var])
+            ..test|var)
         (_.cover [/.Access]
                  (and (expression (|>> (:as Frac) (f.= (f.+ float/0 float/0)))
                                   (let [@ (/.item (/.int +0) $foreign)]
@@ -483,7 +580,7 @@
 (def: test|loop
   Test
   (do [! random.monad]
-    [input random.int
+    [input (# ! each (i.right_shifted 32) random.int)
      iterations (# ! each (n.% 10) random.nat)
      .let [$input (/.local "input")
            $output (/.local "output")
@@ -728,7 +825,7 @@
         (_.for [/.Block]
                ..test|function)
         (_.for [/.Location]
-               ..test/location)
+               ..test|location)
         )))
 
 (def: test|global
diff --git a/stdlib/source/test/lux/tool.lux b/stdlib/source/test/lux/tool.lux
index 635322a92..78aaee40e 100644
--- a/stdlib/source/test/lux/tool.lux
+++ b/stdlib/source/test/lux/tool.lux
@@ -14,7 +14,8 @@
      ["[1][0]" analysis]
      ["[1][0]" phase "_"
       ["[1]/[0]" extension]
-      ... ["[1]/[0]" analysis]
+      ["[1]/[0]" analysis "_"
+       ["[1]/[0]" simple]]
       ... ["[1]/[0]" synthesis]
       ]]]
    ["[1][0]" meta "_"
@@ -38,7 +39,7 @@
       /meta/archive/key.test
       /meta/archive/document.test
       /phase/extension.test
+      /phase/analysis/simple.test
       ... /syntax.test
-      ... /analysis.test
       ... /synthesis.test
       ))
diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/analysis.lux b/stdlib/source/test/lux/tool/compiler/language/lux/analysis.lux
index 210d6d29a..69c608fda 100644
--- a/stdlib/source/test/lux/tool/compiler/language/lux/analysis.lux
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/analysis.lux
@@ -169,8 +169,8 @@
                               _
                               false))]
 
-                  [/.variable/local expected_register]
-                  [/.variable/foreign expected_register]
+                  [/.local expected_register]
+                  [/.foreign expected_register]
                   [/.constant expected_constant]
                   [/.variable expected_variable]
                   ))
@@ -184,7 +184,7 @@
      _
      false)])
 
-(def: test|application
+(def: test|reification
   Test
   (do random.monad
     [expected_abstraction (random.only (|>> (..tagged? /.#Apply) not)
@@ -192,10 +192,10 @@
      expected_parameter/0 (..random 2)
      expected_parameter/1 (..random 2)]
     ($_ _.and
-        (_.cover [/.apply /.application]
+        (_.cover [/.reified /.reification]
                  (case (|> [expected_abstraction (list expected_parameter/0 expected_parameter/1)]
-                           /.apply
-                           /.application)
+                           /.reified
+                           /.reification)
                    (^ [actual_abstraction (list actual_parameter/0 actual_parameter/1)])
                    (and (same? expected_abstraction actual_abstraction)
                         (same? expected_parameter/0 actual_parameter/0)
@@ -421,8 +421,8 @@
             ..test|simple
             ..test|complex
             ..test|reference
-            (_.for [/.Application]
-                   ..test|application)
+            (_.for [/.Reification]
+                   ..test|reification)
             (_.for [/.Branch /.Branch' /.Match /.Match']
                    ..test|case)
             (_.for [/.Operation /.Phase /.Handler /.Bundle]
diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/primitive.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/primitive.lux
deleted file mode 100644
index 252148fb5..000000000
--- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/primitive.lux
+++ /dev/null
@@ -1,115 +0,0 @@
-(.using
-  [lux {"-" primitive}
-   ["@" target]
-   [abstract
-    ["[0]" monad {"+" do}]]
-   [data
-    ["%" text/format {"+" format}]]
-   ["r" math/random {"+" Random} ("[1]#[0]" monad)]
-   ["_" test {"+" Test}]
-   [control
-    pipe
-    ["[0]" try {"+" Try}]
-    ["[0]" exception {"+" exception:}]]
-   [macro
-    ["[0]" code]]
-   [meta
-    ["[0]" symbol]]]
-  [\\
-   ["[0]" /
-    ["/[1]" //
-     ["[1][0]" type]
-     ["/[1]" // "_"
-      [extension
-       ["[0]" bundle]
-       ["[1][0]" analysis]]
-      ["/[1]" // "_"
-       ["[0]" version]
-       ["[1][0]" analysis {"+" Analysis Operation}
-        [macro {"+" Expander}]
-        [evaluation {"+" Eval}]]
-       [///
-        ["[0]" phase]
-        [meta
-         ["[0]" archive]]]]]]]])
-
-(def: .public (expander macro inputs state)
-  Expander
-  {try.#Failure "NOPE"})
-
-(def: .public (eval archive count type expression)
-  Eval
-  (function (_ state)
-    {try.#Failure "NO!"}))
-
-(def: .public phase
-  ////analysis.Phase
-  (//.phase ..expander))
-
-(def: .public state
-  ////analysis.State+
-  [(///analysis.bundle ..eval bundle.empty)
-   (////analysis.state (////analysis.info version.version @.jvm))])
-
-(def: .public primitive
-  (Random [Type Code])
-  (`` ($_ r.either
-          (~~ (template [<type> <code_wrapper> <value_gen>]
-                [(r.and (r#in <type>) (r#each <code_wrapper> <value_gen>))]
-
-                [Any  code.tuple (r.list 0 (r#in (' [])))]
-                [Bit  code.bit   r.bit]
-                [Nat  code.nat   r.nat]
-                [Int  code.int   r.int]
-                [Rev  code.rev   r.rev]
-                [Frac code.frac  r.frac]
-                [Text code.text  (r.unicode 5)]
-                )))))
-
-(exception: (wrong_inference [expected Type
-                              inferred Type])
-  (exception.report
-   ["Expected" (%.type expected)]
-   ["Inferred" (%.type inferred)]))
-
-(def: (infer expected_type analysis)
-  (-> Type (Operation Analysis) (Try Analysis))
-  (|> analysis
-      //type.with_inference
-      (phase.result ..state)
-      (case> {try.#Success [inferred_type output]}
-             (if (same? expected_type inferred_type)
-               {try.#Success output}
-               (exception.except wrong_inference [expected_type inferred_type]))
-
-             {try.#Failure error}
-             {try.#Failure error})))
-
-(def: .public test
-  (<| (_.context (symbol.module (symbol /._)))
-      (`` ($_ _.and
-              (_.test (%.symbol (symbol ////analysis.#Unit))
-                      (|> (infer Any (..phase archive.empty (' [])))
-                          (case> (^ {try.#Success {////analysis.#Primitive {////analysis.#Unit output}}})
-                                 (same? [] output)
-
-                                 _
-                                 false)))
-              (~~ (template [<type> <tag> <random> <constructor>]
-                    [(do r.monad
-                       [sample <random>]
-                       (_.test (%.symbol (symbol <tag>))
-                               (|> (infer <type> (..phase archive.empty (<constructor> sample)))
-                                   (case> {try.#Success {////analysis.#Primitive {<tag> output}}}
-                                          (same? sample output)
-
-                                          _
-                                          false))))]
-
-                    [Bit  ////analysis.#Bit  r.bit         code.bit]
-                    [Nat  ////analysis.#Nat  r.nat         code.nat]
-                    [Int  ////analysis.#Int  r.int         code.int]
-                    [Rev  ////analysis.#Rev  r.rev         code.rev]
-                    [Frac ////analysis.#Frac r.frac        code.frac]
-                    [Text ////analysis.#Text (r.unicode 5) code.text]
-                    ))))))
diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/simple.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/simple.lux
new file mode 100644
index 000000000..015c9d362
--- /dev/null
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/simple.lux
@@ -0,0 +1,88 @@
+(.using
+ [library
+  [lux "*"
+   ["_" test {"+" Test}]
+   ["[0]" type ("[1]#[0]" equivalence)]
+   [abstract
+    [monad {"+" do}]]
+   [control
+    [pipe {"+" case>}]
+    ["[0]" try]]
+   [math
+    ["[0]" random]]]]
+ [\\library
+  ["[0]" /
+   [//
+    ["[1][0]" type]
+    [//
+     ["[1][0]" extension]
+     [//
+      ["[1][0]" analysis {"+" Analysis Operation}]
+      [///
+       ["[1][0]" phase]]]]]]])
+
+(def: (analysis state type it ?)
+  (-> Lux Type (Operation Analysis) (-> Analysis Bit) Bit)
+  (and (|> (/type.with_type type
+             it)
+           (/phase.result [/extension.#bundle /extension.empty
+                           /extension.#state state])
+           (case> (^ {try.#Success analysis})
+                  (? analysis)
+
+                  _
+                  false))
+       (|> (/type.with_type .Nothing
+             it)
+           (/phase.result [/extension.#bundle /extension.empty
+                           /extension.#state state])
+           (case> (^ {try.#Failure error})
+                  true
+
+                  _
+                  false))
+       (|> (/type.with_inference
+             it)
+           (/phase.result [/extension.#bundle /extension.empty
+                           /extension.#state state])
+           (case> (^ {try.#Success [inferred analysis]})
+                  (and (type#= type inferred)
+                       (? analysis))
+
+                  _
+                  false))))
+
+(template: (analysis? <type> <tag>)
+  [(: (-> <type> Analysis Bit)
+      (function (_ expected)
+        (|>> (case> (^ (<tag> actual))
+                    (same? expected actual)
+
+                    _
+                    false))))])
+
+(def: .public test
+  (<| (_.covering /._)
+      (do [! random.monad]
+        [version random.nat
+         host (random.ascii/lower 5)
+         .let [state (/analysis.state (/analysis.info version host))]]
+        (`` ($_ _.and
+                (_.cover [/.unit]
+                         (..analysis state .Any /.unit
+                                     (|>> (case> (^ (/analysis.unit)) true _ false))))
+                (~~ (template [<analysis> <type> <random> <tag>]
+                      [(do !
+                         [sample <random>]
+                         (_.cover [<analysis>]
+                                  (..analysis state <type> (<analysis> sample)
+                                              ((..analysis? <type> <tag>) sample))))]
+
+                      [/.bit .Bit random.bit /analysis.bit]
+                      [/.nat .Nat random.nat /analysis.nat]
+                      [/.int .Int random.int /analysis.int]
+                      [/.rev .Rev random.rev /analysis.rev]
+                      [/.frac .Frac random.frac /analysis.frac]
+                      [/.text .Text (random.unicode 1) /analysis.text]
+                      ))
+                )))))