Dusting off the pure-Lux JVM compiler machinery. [Part 2]

8 files changed, 286 insertions, 181 deletions

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 449060cf0..5b49ae38a 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
@@ -1,7 +1,7 @@
 (.using
  [library
   [lux {"-" Type Definition Primitive}
-   ["[0]" ffi]
+   ["[0]" ffi {"+" import:}]
    [abstract
     ["[0]" monad {"+" do}]]
    [control
@@ -56,7 +56,7 @@
          ["[0]A" type]]
         [generation
          [jvm
-          [runtime {"+" Anchor Definition}]]]
+          [runtime {"+" Anchor Definition Extender}]]]
         ["[0]" extension
          ["[0]" bundle]
          [analysis
@@ -307,8 +307,10 @@
             (generation.log! (format "Class " name)))]
         (in directive.no_requirements)))]))
 
-(def: .public bundle
-  (Bundle Anchor (Bytecode Any) Definition)
+(import: java/lang/ClassLoader)
+
+(def: .public (bundle class_loader extender)
+  (-> java/lang/ClassLoader Extender (Bundle Anchor (Bytecode Any) Definition))
   (<| (bundle.prefix "jvm")
       (|> bundle.empty
           ... TODO: Finish handling methods and un-comment.
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 a6fa7de6d..b15832011 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
@@ -1,55 +1,64 @@
 (.using
-  [library
-   [lux {"-" Definition}
-    ["[0]" ffi {"+" import: do_to object}]
-    [abstract
-     [monad {"+" do}]]
-    [control
-     pipe
-     ["[0]" try {"+" Try}]
-     ["[0]" exception {"+" exception:}]
-     ["[0]" io {"+" IO io}]
-     [concurrency
-      ["[0]" atom {"+" Atom atom}]]]
-    [data
-     [binary {"+" Binary}]
-     ["[0]" product]
-     ["[0]" text ("[1]#[0]" hash)
-      ["%" format {"+" format}]]
-     [collection
-      ["[0]" array]
-      ["[0]" dictionary {"+" Dictionary}]
-      ["[0]" sequence]]
-     ["[0]" format "_"
-      ["[1]" binary]]]
-    [target
-     [jvm
-      ["[0]" loader {"+" Library}]
-      ["_" bytecode {"+" Bytecode}]
-      ["[0]" modifier {"+" Modifier} ("[1]#[0]" monoid)]
-      ["[0]" field {"+" Field}]
-      ["[0]" method {"+" Method}]
-      ["[0]" version]
-      ["[0]" class {"+" Class}]
-      ["[0]" encoding "_"
-       ["[1]/[0]" name]]
-      ["[0]" type
-       ["[0]" descriptor]]]]
-    [tool
-     [compiler
-      ["[0]" name]]]]]
-  ["[0]" // "_"
-   ["[1][0]" runtime {"+" Definition}]]
-  )
+ [library
+  [lux {"-" Definition}
+   ["[0]" ffi {"+" import: do_to object}]
+   [abstract
+    [monad {"+" do}]]
+   [control
+    pipe
+    ["[0]" maybe]
+    ["[0]" try {"+" Try}]
+    ["[0]" exception {"+" exception:}]
+    ["[0]" io {"+" IO io}]
+    [concurrency
+     ["[0]" atom {"+" Atom atom}]]]
+   [data
+    [binary {"+" Binary}]
+    ["[0]" product]
+    ["[0]" text ("[1]#[0]" hash)
+     ["%" format {"+" format}]]
+    [collection
+     ["[0]" array]
+     ["[0]" dictionary {"+" Dictionary}]
+     ["[0]" sequence]]
+    ["[0]" format "_"
+     ["[1]" binary]]]
+   [target
+    [jvm
+     ["_" bytecode {"+" Bytecode}]
+     ["[0]" loader {"+" Library}]
+     ["[0]" modifier {"+" Modifier} ("[1]#[0]" monoid)]
+     ["[0]" field {"+" Field}]
+     ["[0]" method {"+" Method}]
+     ["[0]" version]
+     ["[0]" class {"+" Class}]
+     ["[0]" encoding "_"
+      ["[1]/[0]" name]]
+     ["[0]" type
+      ["[0]" descriptor]]]]
+   [tool
+    [compiler
+     [language
+      [lux
+       [version {"+" version}]
+       [generation {"+" Context}]]]
+     [meta
+      [io {"+" lux_context}]]]]]]
+ ["[0]" // "_"
+  ["[1][0]" runtime {"+" Definition}]]
+ )
 
 (import: java/lang/reflect/Field
-  (get ["?" java/lang/Object] "try" "?" java/lang/Object))
+  ["[1]::[0]"
+   (get ["?" java/lang/Object] "try" "?" java/lang/Object)])
 
 (import: (java/lang/Class a)
-  (getField [java/lang/String] "try" java/lang/reflect/Field))
+  ["[1]::[0]"
+   (getField [java/lang/String] "try" java/lang/reflect/Field)])
 
 (import: java/lang/Object
-  (getClass [] (java/lang/Class java/lang/Object)))
+  ["[1]::[0]"
+   (getClass [] (java/lang/Class java/lang/Object))])
 
 (import: java/lang/ClassLoader)
 
@@ -57,7 +66,7 @@
 (def: value::type (type.class "java.lang.Object" (list)))
 (def: value::modifier ($_ modifier#composite field.public field.final field.static))
 
-(def: init::type (type.method [(list) type.void (list)]))
+(def: init::type (type.method [(list) (list) type.void (list)]))
 (def: init::modifier ($_ modifier#composite method.public method.static method.strict))
 
 (exception: .public (cannot_load [class Text
@@ -100,6 +109,13 @@
 (def: class_path_separator
   ".")
 
+(def: .public (class_name [module_id artifact_id])
+  (-> Context Text)
+  (format lux_context
+          ..class_path_separator (%.nat version)
+          ..class_path_separator (%.nat module_id)
+          ..class_path_separator (%.nat artifact_id)))
+
 (def: (evaluate! library loader eval_class valueG)
   (-> Library java/lang/ClassLoader Text (Bytecode Any) (Try [Any Definition]))
   (let [bytecode_name (text.replaced class_path_separator .module_separator eval_class)
@@ -125,8 +141,8 @@
                (in [value
                     [eval_class bytecode]])))))
 
-(def: (execute! library loader temp_label [class_name class_bytecode])
-  (-> Library java/lang/ClassLoader Text Definition (Try Any))
+(def: (execute! library loader [class_name class_bytecode])
+  (-> Library java/lang/ClassLoader Definition (Try Any))
   (io.run! (do (try.with io.monad)
              [existing_class? (|> (atom.read! library)
                                   (# io.monad each (function (_ library)
@@ -138,28 +154,43 @@
                   (loader.store class_name class_bytecode library))]
              (loader.load class_name loader))))
 
-(def: (define! library loader [module name] valueG)
-  (-> Library java/lang/ClassLoader Symbol (Bytecode Any) (Try [Text Any Definition]))
-  (let [class_name (format (text.replaced .module_separator class_path_separator module)
-                           class_path_separator (name.normal name)
-                           "___" (%.nat (text#hash name)))]
+(def: (define! library loader context custom valueG)
+  (-> Library java/lang/ClassLoader Context (Maybe Text) (Bytecode Any) (Try [Text Any Definition]))
+  (let [class_name (maybe.else (..class_name context)
+                               custom)]
     (do try.monad
       [[value definition] (evaluate! library loader class_name valueG)]
       (in [class_name value definition]))))
 
 (def: .public host
-  (IO //runtime.Host)
+  (IO [java/lang/ClassLoader //runtime.Host])
   (io (let [library (loader.new_library [])
             loader (loader.memory library)]
-        (: //runtime.Host
-           (implementation
-            (def: (evaluate! temp_label valueG)
-              (let [eval_class (|> temp_label name.normal (text.replaced " " "$"))]
-                (# try.monad each product.left
-                   (..evaluate! library loader eval_class valueG))))
-            
-            (def: execute!
-              (..execute! library loader))
-            
-            (def: define!
-              (..define! library loader)))))))
+        [loader
+         (: //runtime.Host
+            (implementation
+             (def: (evaluate context valueG)
+               (# try.monad each product.left
+                  (..evaluate! library loader (class_name context) valueG)))
+             
+             (def: execute
+               (..execute! library loader))
+             
+             (def: define
+               (..define! library loader))
+
+             (def: (ingest context bytecode)
+               [(..class_name context) bytecode])
+
+             (def: (re_learn context custom [_ bytecode])
+               (io.run! (loader.store (maybe.else (..class_name context) custom) bytecode library)))
+             
+             (def: (re_load context custom [directive_name bytecode])
+               (io.run!
+                (do (try.with io.monad)
+                  [.let [class_name (maybe.else (..class_name context)
+                                                custom)]
+                   _ (loader.store class_name bytecode library)
+                   class (loader.load class_name loader)]
+                  (# io.monad in (..class_value class_name class)))))
+             ))])))
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 cea2a90f6..d788e3526 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
@@ -20,14 +20,17 @@
       [encoding
        ["[0]" name]]
       ["[0]" type
-       ["[0]" reflection]]]]]]
+       ["[0]" reflection]]]]
+    [tool
+     [compiler
+      [language
+       [lux
+        [generation {"+" Context}]
+        [program {"+" Program}]]]]]]]
   ["[0]" //
    ["[1][0]" runtime {"+" Definition}]
    ["[1][0]" function/abstract]])
 
-(def: .public class
-  "LuxProgram")
-
 (def: ^Object
   (type.class "java.lang.Object" (list)))
 
@@ -37,7 +40,8 @@
 (def: ^Args
   (type.array ^String))
 
-(def: main::type (type.method [(list ..^Args) type.void (list)]))
+(def: main::type
+  (type.method [(list) (list ..^Args) type.void (list)]))
 
 (def: main::modifier
   (Modifier Method)
@@ -128,8 +132,8 @@
       _.aconst_null
       //runtime.apply))
 
-(def: .public (program program)
-  (-> (Bytecode Any) Definition)
+(def: .public (program artifact_name context program)
+  (-> (-> Context Text) (Program (Bytecode Any) Definition))
   (let [super_class (|> ..^Object type.reflection reflection.reflection name.internal)
         main (method.method ..main::modifier "main" ..main::type
                             (list)
@@ -138,13 +142,14 @@
                                         ..input_list
                                         ..feed_inputs
                                         ..run_io
-                                        _.return)})]
-    [..class
+                                        _.return)})
+        class (artifact_name context)]
+    [class
      (<| (format.result class.writer)
          try.trusted
          (class.class version.v6_0
                       ..program::modifier
-                      (name.internal ..class)
+                      (name.internal class)
                       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 99dbb01aa..c753851bc 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
@@ -1,63 +1,65 @@
 (.using
-  [library
-   [lux {"-" Type Definition Label case false true try}
-    [abstract
-     ["[0]" monad {"+" do}]
-     ["[0]" enum]]
-    [control
-     ["[0]" try]]
-    [data
-     [binary {"+" Binary}]
-     [collection
-      ["[0]" list ("[1]#[0]" functor)]
-      ["[0]" sequence]]
-     ["[0]" format "_"
-      ["[1]" binary]]
-     [text
-      ["%" format {"+" format}]]]
-    [math
-     [number
-      ["n" nat]
-      ["[0]" i32]
-      ["[0]" i64]]]
-    [target
-     ["[0]" jvm "_"
-      ["_" bytecode {"+" Label Bytecode}]
-      ["[0]" modifier {"+" Modifier} ("[1]#[0]" monoid)]
-      ["[0]" field {"+" Field}]
-      ["[0]" method {"+" Method}]
-      ["[1]/[0]" version]
-      ["[0]" class {"+" Class}]
-      ["[0]" constant
-       [pool {"+" Resource}]]
-      [encoding
-       ["[0]" name]]
-      ["[0]" type {"+" Type}
-       ["[0]" category {"+" Return' Value'}]
-       ["[0]" reflection]]]]]]
-  ["[0]" // "_"
-   ["[1][0]" type]
-   ["[1][0]" value]
-   ["[1][0]" function "_"
-    ["[1]" abstract]
-    [field
-     [constant
-      ["[1]/[0]" arity]]
-     [variable
-      ["[1]/[0]" count]]]]
-   ["//[1]" /// "_"
-    [//
-     ["[0]" version]
-     ["[0]" synthesis]
-     ["[0]" generation]
-     [///
-      ["[1]" phase]
-      [arity {"+" Arity}]
-      [reference
-       [variable {"+" Register}]]
-      [meta
-       [io {"+" lux_context}]
-       [archive {"+" Archive}]]]]]])
+ [library
+  [lux {"-" Type Definition Label case false true try}
+   [abstract
+    ["[0]" monad {"+" do}]
+    ["[0]" enum]]
+   [control
+    ["[0]" try]]
+   [data
+    [binary {"+" Binary}]
+    ["[0]" product]
+    [collection
+     ["[0]" list ("[1]#[0]" functor)]
+     ["[0]" sequence]]
+    ["[0]" format "_"
+     ["[1]" binary]]
+    [text
+     ["%" format {"+" format}]]]
+   [math
+    [number
+     ["n" nat]
+     ["[0]" i32]
+     ["[0]" i64]]]
+   [target
+    ["[0]" jvm "_"
+     ["_" bytecode {"+" Label Bytecode}]
+     ["[0]" modifier {"+" Modifier} ("[1]#[0]" monoid)]
+     ["[0]" field {"+" Field}]
+     ["[0]" method {"+" Method}]
+     ["[1]/[0]" version]
+     ["[0]" class {"+" Class}]
+     ["[0]" constant
+      [pool {"+" Resource}]]
+     [encoding
+      ["[0]" name]]
+     ["[0]" type {"+" Type}
+      ["[0]" category {"+" Return' Value'}]
+      ["[0]" reflection]]]]]]
+ ["[0]" // "_"
+  ["[1][0]" type]
+  ["[1][0]" value]
+  ["[1][0]" function "_"
+   ["[1]" abstract]
+   [field
+    [constant
+     ["[1]/[0]" arity]]
+    [variable
+     ["[1]/[0]" count]]]]
+  ["//[1]" /// "_"
+   [//
+    ["[0]" version]
+    ["[0]" synthesis]
+    ["[0]" generation]
+    [///
+     ["[1]" phase]
+     [arity {"+" Arity}]
+     [reference
+      [variable {"+" Register}]]
+     [meta
+      [io {"+" lux_context}]
+      [archive {"+" Output Archive}
+       ["[0]" artifact {"+" Registry}]]]]]]])
 
 (type: .public Byte_Code
   Binary)
@@ -76,6 +78,7 @@
   [Phase generation.Phase]
   [Handler generation.Handler]
   [Bundle generation.Bundle]
+  [Extender generation.Extender]
   )
 
 (type: .public (Generator i)
@@ -511,7 +514,7 @@
 (def: ^Object (type.class "java.lang.Object" (list)))
 
 (def: generate_runtime
-  (Operation Any)
+  (Operation [artifact.ID (Maybe Text) Binary])
   (let [class (..reflection ..class)
         modifier (: (Modifier Class)
                     ($_ modifier#composite
@@ -538,8 +541,9 @@
                                           ..try::method))
                                   (sequence.sequence)))]
     (do ////.monad
-      [_ (generation.execute! [class bytecode])]
-      (generation.save! ..artifact_id {.#None} [class bytecode]))))
+      [_ (generation.execute! [class bytecode])
+       _ (generation.save! ..artifact_id {.#None} [class bytecode])]
+      (in [..artifact_id {.#None} bytecode]))))
 
 (def: generate_function
   (Operation Any)
@@ -599,10 +603,20 @@
       (generation.save! //function.artifact_id {.#None} [class bytecode]))))
 
 (def: .public generate
-  (Operation Any)
+  (Operation [Registry Output])
   (do ////.monad
-    [_ ..generate_runtime]
-    ..generate_function))
+    [runtime_payload ..generate_runtime
+     ... _ ..generate_function
+     ]
+    (in [(|> artifact.empty
+             (artifact.resource .true artifact.no_dependencies)
+             product.right
+             ... (artifact.resource .true artifact.no_dependencies)
+             ... product.right
+             )
+         (sequence.sequence runtime_payload
+                            ... function_payload
+                            )])))
 
 (def: .public forge_label
   (Operation Label)
diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux
index c200a0316..86ed33be3 100644
--- a/stdlib/source/test/lux.lux
+++ b/stdlib/source/test/lux.lux
@@ -56,7 +56,7 @@
             ["[1][0]" target]
             ["[1][0]" test]
             ["[1][0]" time]
-            ... ["[1][0]" tool] ... TODO: Update & expand tests for this
+            ["[1][0]" tool]
             ["[1][0]" type]
             ["[1][0]" world]
             ["[1][0]" ffi]
@@ -97,7 +97,7 @@
                              /target.test
                              /test.test
                              /time.test
-                             ... /tool.test
+                             /tool.test
                              /type.test
                              /world.test
                              /ffi.test
diff --git a/stdlib/source/test/lux/data/collection/array.lux b/stdlib/source/test/lux/data/collection/array.lux
index d9e3f01c2..2eca1688b 100644
--- a/stdlib/source/test/lux/data/collection/array.lux
+++ b/stdlib/source/test/lux/data/collection/array.lux
@@ -1,27 +1,28 @@
 (.using
-  [library
-   [lux "*"
-    ["_" test {"+" Test}]
-    [abstract
-     [monad {"+" do}]
-     [\\specification
-      ["$[0]" equivalence]
-      ["$[0]" monoid]
-      ["$[0]" mix]
-      ["$[0]" functor {"+" Injection}]]]
-    [control
-     ["[0]" maybe]]
-    [data
-     ["[0]" bit]
-     [collection
-      ["[0]" list]
-      ["[0]" set]]]
-    [math
-     ["[0]" random {"+" Random}]
-     [number
-      ["n" nat]]]]]
-  [\\library
-   ["[0]" / {"+" Array}]])
+ [library
+  [lux "*"
+   ["_" test {"+" Test}]
+   [abstract
+    [monad {"+" do}]
+    [\\specification
+     ["$[0]" equivalence]
+     ["$[0]" monoid]
+     ["$[0]" mix]
+     ["$[0]" functor {"+" Injection}]]]
+   [control
+    ["[0]" maybe]]
+   [data
+    ["[0]" bit]
+    ["[0]" text ("[1]#[0]" equivalence)]
+    [collection
+     ["[0]" list]
+     ["[0]" set]]]
+   [math
+    ["[0]" random {"+" Random}]
+    [number
+     ["n" nat]]]]]
+ [\\library
+  ["[0]" / {"+" Array}]])
 
 (def: injection
   (Injection Array)
@@ -29,7 +30,7 @@
 
 (def: bounded_size
   (Random Nat)
-  (# random.monad each (|>> (n.% 100) (n.+ 1))
+  (# random.monad each (|>> (n.% 20) ++)
      random.nat))
 
 (def: structures
@@ -54,8 +55,28 @@
      base random.nat
      shift random.nat
      .let [expected (n.+ base shift)]
-     the_array (random.array size random.nat)]
+     the_array (random.array size random.nat)
+     evens (random.array size (random.only n.even? random.nat))]
     ($_ _.and
+        (let [(^open "/#[0]") /.functor
+              choose (: (-> Nat (Maybe Text))
+                        (function (_ value)
+                          (if (n.even? value)
+                            {.#Some (# n.decimal encoded value)}
+                            {.#None})))]
+          (_.cover [/.one]
+                   (case [(|> evens
+                              (/#each (# n.decimal encoded))
+                              (/.read! 0))
+                          (/.one choose evens)]
+                     [{.#Some expected} {.#Some actual}]
+                     (text#= expected actual)
+
+                     [{.#None} {.#None}]
+                     true
+
+                     _
+                     false)))
         (_.cover [/.example]
                  (# (maybe.equivalence n.equivalence) =
                     (/.example n.even? the_array)
diff --git a/stdlib/source/test/lux/tool.lux b/stdlib/source/test/lux/tool.lux
index 3a9f547cd..5a7509b99 100644
--- a/stdlib/source/test/lux/tool.lux
+++ b/stdlib/source/test/lux/tool.lux
@@ -4,17 +4,20 @@
     ["_" test {"+" Test}]]]
   ["[0]" / "_"
    [compiler
-    [language
-     [lux
-      ["[1][0]" syntax]
-      [phase
-       ["[1][0]" analysis]
-       ["[1][0]" synthesis]]]]]])
+    ["[1][0]" arity]
+    ... [language
+    ...  [lux
+    ...   ["[1][0]" syntax]
+    ...   [phase
+    ...    ["[1][0]" analysis]
+    ...    ["[1][0]" synthesis]]]]
+    ]])
 
 (def: .public test
   Test
   ($_ _.and
-      /syntax.test
-      /analysis.test
-      /synthesis.test
+      /arity.test
+      ... /syntax.test
+      ... /analysis.test
+      ... /synthesis.test
       ))
diff --git a/stdlib/source/test/lux/tool/compiler/arity.lux b/stdlib/source/test/lux/tool/compiler/arity.lux
new file mode 100644
index 000000000..0e9f3f25d
--- /dev/null
+++ b/stdlib/source/test/lux/tool/compiler/arity.lux
@@ -0,0 +1,29 @@
+(.using
+ [library
+  [lux "*"
+   ["_" test {"+" Test}]
+   [abstract
+    [monad {"+" do}]]
+   [data
+    ["[0]" bit ("[1]#[0]" equivalence)]]
+   [math
+    ["[0]" random {"+" Random}]
+    [number
+     ["n" nat]]]]]
+ [\\library
+  ["[0]" /]])
+
+(def: .public test
+  Test
+  (<| (_.covering /._)
+      (_.for [/.Arity])
+      (do [! random.monad]
+        [arity (# ! each (n.% 3) random.nat)]
+        ($_ _.and
+            (_.cover [/.nullary?]
+                     (bit#= (n.= 0 arity) (/.nullary? arity)))
+            (_.cover [/.unary?]
+                     (bit#= (n.= 1 arity) (/.unary? arity)))
+            (_.cover [/.multiary?]
+                     (bit#= (n.>= 2 arity) (/.multiary? arity)))
+            ))))