No longer depending on the ASM library for JVM bytecode generation.

1 files changed, 118 insertions, 239 deletions

diff --git a/lux-jvm/source/program.lux b/lux-jvm/source/program.lux
index 61593c215..c1f70ec10 100644
--- a/lux-jvm/source/program.lux
+++ b/lux-jvm/source/program.lux
@@ -1,102 +1,81 @@
 (.using
-  [library
-   [lux {"-" Definition}
-    [program {"+" program:}]
-    ["@" target]
-    ["[0]" ffi {"+" import:}]
-    [abstract
-     [monad {"+" do}]]
-    [control
-     ["[0]" io {"+" IO}]
-     ["[0]" try {"+" Try}]
-     [concurrency
-      ["[0]" async {"+" Async}]]]
-    [data
-     ["[0]" product]
-     [text
-      ["%" format {"+" format}]]
-     [collection
-      [array {"+" Array}]
-      ["[0]" dictionary]]]
-    ["[0]" world "_"
-     ["[0]" file]
-     ["[1]/[0]" program]]
-    [target
-     ["[0]" jvm "_"
-      [bytecode {"+" Bytecode}]
-      ["[1]/[0]" type
-       ["[1]/[0]" box]]]]
-    [tool
-     [compiler
-      [reference {"+" }]
-      ["[0]" phase]
-      [default
-       ["[0]" platform {"+" Platform}]]
-      [meta
-       [archive {"+" Archive}]
-       ["[0]" packager "_"
-        ["[1]" jvm]]]
-      [language
-       [lux
-        ["$" synthesis {"+" Synthesis}]
-        ["[0]" generation]
-        [analysis
-         [macro {"+" Expander}]]
-        [phase
-         [extension {"+" Phase Bundle Operation Handler Extender}
-          ["[0]" analysis "_"
-           ["[1]" jvm]]
-          ... ["[0]" generation "_"
-          ...  ["[1]" jvm]]
-          ... ["[0]" directive "_"
-          ...  ["[1]" jvm]]
-          ]
-         [generation
-          ["[0]" jvm "_"
-           ["[1]/[0]" runtime]
-           ... ["[1]/[0]" host]
-           ]]]]]]]]]
-  [program
-   ["/" compositor
-    ["/[0]" cli]
-    ["/[0]" static]]]
-  [luxc
-   [lang
-    [host
-     ["_" jvm]]
-    ["[0]" directive "_"
-     ["[1]" jvm]]
-    [translation
-     ["[0]" jvm
-      ["[0]" runtime]
-      ["[0]" expression]
-      ["[0]" function]
-      ["[1]/[0]" program]
-      ["translation" extension]]]]])
+ [library
+  [lux {"-" Definition}
+   [program {"+" program:}]
+   ["@" target]
+   ["[0]" ffi {"+" import:}]
+   [abstract
+    [monad {"+" do}]]
+   [control
+    ["[0]" io {"+" IO}]
+    ["[0]" try {"+" Try}]
+    [concurrency
+     ["[0]" async {"+" Async}]]]
+   [data
+    ["[0]" product]
+    [text
+     ["%" format {"+" format}]]
+    [collection
+     [array {"+" Array}]]]
+   ["[0]" world "_"
+    ["[0]" file]
+    ["[1]/[0]" program]]
+   [target
+    ["[0]" jvm "_"
+     [bytecode {"+" Bytecode}]
+     ["[1]/[0]" type
+      ["[1]/[0]" box]]]]
+   [tool
+    [compiler {"+"}
+     ["[0]" phase]
+     [default
+      ["[0]" platform {"+" Platform}]]
+     [meta
+      [archive {"+" Archive}]
+      ["[0]" context]
+      ["[0]" cli]
+      ["[0]" packager "_"
+       ["[1]" jvm]]]
+     [language
+      [lux
+       [generation {"+" Operation}]
+       [analysis
+        [macro {"+" Expander}]]
+       [phase
+        ["[0]" extension
+         ["[0]" analysis "_"
+          ["[1]" jvm]]
+         ["[0]" generation "_"
+          ["[1]" jvm]]
+         ["[0]" directive "_"
+          ["[1]" jvm]]]
+        [generation
+         ["/" jvm
+          ["[1][0]" runtime {"+" Anchor Definition}]
+          ["[1][0]" host]
+          ["[1][0]" program]]]]]]]]]]
+ [program
+  ["[0]" compositor]])
 
 (import: java/lang/reflect/Method
-  ["[1]::[0]"
-   (invoke [java/lang/Object [java/lang/Object]] "try" java/lang/Object)])
+  "[1]::[0]"
+  (invoke [java/lang/Object [java/lang/Object]] "try" java/lang/Object))
 
-(import: java/lang/ClassLoader)
+(import: java/lang/ClassLoader
+  "[1]::[0]")
 
 (import: (java/lang/Class c)
-  ["[1]::[0]"
-   (getMethod [java/lang/String [(java/lang/Class java/lang/Object)]] "try" java/lang/reflect/Method)])
+  "[1]::[0]"
+  (getMethod [java/lang/String [(java/lang/Class java/lang/Object)]] "try" java/lang/reflect/Method))
 
 (import: java/lang/Object
-  ["[1]::[0]"
-   (getClass [] (java/lang/Class java/lang/Object))])
+  "[1]::[0]"
+  (getClass [] (java/lang/Class java/lang/Object)))
 
 (def: _object_class
   (java/lang/Class java/lang/Object)
   (ffi.class_for java/lang/Object))
 
-(def: _apply1_args
-  (Array (java/lang/Class java/lang/Object))
-  (|> (ffi.array (java/lang/Class java/lang/Object) 1)
-      (ffi.write! 0 _object_class)))
-
 (def: _apply2_args
   (Array (java/lang/Class java/lang/Object))
   (|> (ffi.array (java/lang/Class java/lang/Object) 2)
@@ -116,192 +95,92 @@
   Expander
   (do try.monad
     [apply_method (|> macro
-                      (:as java/lang/Object)
+                      (as java/lang/Object)
                       (java/lang/Object::getClass)
                       (java/lang/Class::getMethod "apply" _apply2_args))]
-    (:as (Try (Try [Lux (List Code)]))
-         (java/lang/reflect/Method::invoke
-          (:as java/lang/Object macro)
-          (|> (ffi.array java/lang/Object 2)
-              (ffi.write! 0 (:as java/lang/Object inputs))
-              (ffi.write! 1 (:as java/lang/Object lux)))
-          apply_method))))
-
-... DEPRECATED
-... (def: how_to_wrap_a_phase
-...   Synthesis
-...   (let [java/lang/String (jvm/type.class "java.lang.String" (list))
-...         <java/lang/Class> (jvm/type.array (jvm/type.class "java.lang.Class" (list)))
-...         java/lang/Object (jvm/type.class "java.lang.Object" (list))
-...         <java/lang/Object> (jvm/type.array java/lang/Object)
-
-...         jvm_type (: (All (_ c) (-> (jvm/type.Type c) Synthesis))
-...                     (|>> jvm/type.format
-...                          $.text))
-...         class_type (: (-> Text Synthesis)
-...                       (function (_ name)
-...                         (|> (jvm/type.class name (list))
-...                             jvm_type)))
-...         unwrap_long (: (-> Synthesis Synthesis)
-...                        (|>> (list ($.text jvm/type/box.long)
-...                                   ($.text "long"))
-...                             {$.#Extension "jvm object cast"}))
-...         long_to_int (: (-> Synthesis Synthesis)
-...                        (|>> (list)
-...                             {$.#Extension "jvm conversion long-to-int"}))
-...         literal_nat (: (-> Nat Synthesis)
-...                        (|>> .i64 $.i64 unwrap_long long_to_int))
-...         write! (: (-> Text Nat Synthesis Synthesis Synthesis)
-...                   (function (_ element_class index value array)
-...                     {$.#Extension "jvm array write object"
-...                                   (list (jvm_type (jvm/type.array (jvm/type.class element_class (list))))
-...                                         (literal_nat index)
-...                                         value
-...                                         array)}))
-...         object_array (: (-> Text Nat Synthesis)
-...                         (function (_ class_name size)
-...                           {$.#Extension "jvm array new object"
-...                                         (list (class_type class_name)
-...                                               (literal_nat size))}))
-...         class_of (: (-> Synthesis Synthesis)
-...                     (function (_ object)
-...                       {$.#Extension "jvm member invoke virtual"
-...                                     (list& (class_type "java.lang.Object")
-...                                            ($.text "getClass")
-...                                            (class_type "java.lang.Class")
-...                                            object
-...                                            (list))}))
-...         input (: (All (_ c) (-> (jvm/type.Type c) Synthesis Synthesis))
-...                  (function (_ value_type value)
-...                    ($.tuple (list (jvm_type value_type) value))))
-        
-...         example_object {$.#Extension "jvm member invoke constructor"
-...                                      (list& (class_type "java.lang.Object")
-...                                             (list))}
-...         phase_arity 3
-...         $phase ($.variable/local 1)
-...         $archive ($.variable/local 2)
-...         $input ($.variable/local 3)
-...         $state ($.variable/local 4)
-...         apply_method {$.#Extension "jvm member invoke virtual"
-...                                    (list& (class_type "java.lang.Class")
-...                                           ($.text "getMethod")
-...                                           (class_type "java.lang.reflect.Method")
-...                                           (class_of $phase)
-...                                           (list (input java/lang/String
-...                                                        ($.text runtime.apply_method))
-...                                                 (input <java/lang/Class>
-...                                                        (|> (object_array "java.lang.Class" phase_arity)
-...                                                            (write! "java.lang.Class" 0 (class_of example_object))
-...                                                            (write! "java.lang.Class" 1 (class_of example_object))
-...                                                            (write! "java.lang.Class" 2 (class_of example_object))))))}]
-...     {$.#Extension "jvm member invoke virtual"
-...                   (list& (class_type "java.lang.reflect.Method")
-...                          ($.text "invoke")
-...                          (class_type "java.lang.Object")
-...                          apply_method
-...                          (list (input java/lang/Object
-...                                       $phase)
-...                                (input <java/lang/Object>
-...                                       (|> (object_array "java.lang.Object" phase_arity)
-...                                           (write! "java.lang.Object" 0 $archive)
-...                                           (write! "java.lang.Object" 1 $input)
-...                                           (write! "java.lang.Object" 2 $state)))))}))
+    (as (Try (Try [Lux (List Code)]))
+        (java/lang/reflect/Method::invoke
+         (as java/lang/Object macro)
+         (|> (ffi.array java/lang/Object 2)
+             (ffi.write! 0 (as java/lang/Object inputs))
+             (ffi.write! 1 (as java/lang/Object lux)))
+         apply_method))))
 
 (def: (phase_wrapper archive)
-  (-> Archive (generation.Operation _.Anchor _.Inst _.Definition phase.Wrapper))
-  (do phase.monad
-    [... instanceG (function.function' {.#Some [0 (.nat -1)]} expression.translate archive [(list) 4 ..how_to_wrap_a_phase])
-     ... phase_wrapper (generation.evaluate! [0 (.nat -2)] instanceG)
-     ]
-    (in (|>>)
-        ... (function (_ phase)
-        ...   (<| try.trusted
-        ...       (: (Try java/lang/Object))
-        ...       (do try.monad
-        ...         [apply_method (|> phase_wrapper
-        ...                           (:as java/lang/Object)
-        ...                           (java/lang/Object::getClass)
-        ...                           (java/lang/Class::getMethod runtime.apply_method _apply1_args))]
-        ...         (java/lang/reflect/Method::invoke
-        ...          (:as java/lang/Object phase_wrapper)
-        ...          (|> (ffi.array java/lang/Object 1)
-        ...              (ffi.write! 0 (:as java/lang/Object phase)))
-        ...          apply_method))))
-        )))
+  (-> Archive (Operation Anchor (Bytecode Any) Definition phase.Wrapper))
+  (# phase.monad in (|>>)))
 
 (def: .public platform
-  ... (IO (Platform Anchor (Bytecode Any) Definition))
   (IO [java/lang/ClassLoader
-       (Platform _.Anchor _.Inst _.Definition)])
+       /runtime.Host
+       (Platform Anchor (Bytecode Any) Definition)])
   (do io.monad
-    [... host jvm/host.host
-     [loader host] jvm.host]
+    [[loader host] /host.host]
     (in [loader
+         host
          [platform.#&file_system (file.async file.default)
           platform.#host host
-          ... platform.#phase jvm.generate
-          platform.#phase expression.translate
-          ... platform.#runtime runtime.generate
-          platform.#runtime runtime.translate
+
+          platform.#phase /.generate
+          platform.#runtime /runtime.generate
+
           platform.#phase_wrapper ..phase_wrapper
           platform.#write product.right]])))
 
 (def: (extender phase_wrapper)
-  (-> phase.Wrapper Extender)
+  (-> phase.Wrapper extension.Extender)
   ... TODO: Stop relying on coercions ASAP.
-  (<| (:as Extender)
+  (<| (as extension.Extender)
       (function (@self handler))
-      (:as Handler)
+      (as extension.Handler)
       (function (@self name phase))
-      (:as Phase)
+      (as extension.Phase)
       (function (@self archive parameters))
-      (:as Operation)
+      (as extension.Operation)
       (function (@self state))
-      (:as Try)
+      (as Try)
       try.trusted
-      (:as Try)
+      (as Try)
       (do try.monad
         [method (|> handler
-                    (:as java/lang/Object)
+                    (as java/lang/Object)
                     (java/lang/Object::getClass)
                     (java/lang/Class::getMethod "apply" _apply5_args))]
         (java/lang/reflect/Method::invoke
-         (:as java/lang/Object handler)
+         (as java/lang/Object handler)
          (|> (ffi.array java/lang/Object 5)
-             (ffi.write! 0 (:as java/lang/Object name))
-             (ffi.write! 1 (:as java/lang/Object (phase_wrapper phase)))
-             (ffi.write! 2 (:as java/lang/Object archive))
-             (ffi.write! 3 (:as java/lang/Object parameters))
-             (ffi.write! 4 (:as java/lang/Object state)))
+             (ffi.write! 0 (as java/lang/Object name))
+             (ffi.write! 1 (as java/lang/Object (phase_wrapper phase)))
+             (ffi.write! 2 (as java/lang/Object archive))
+             (ffi.write! 3 (as java/lang/Object parameters))
+             (ffi.write! 4 (as java/lang/Object state)))
          method))))
 
 (def: (declare_success! _)
   (-> Any (Async Any))
   (async.future (# world/program.default exit +0)))
 
-(program: [service /cli.service]
-  (let [static [/static.#host @.jvm
-                /static.#host_module_extension ".jvm"
-                /static.#target (/cli.target service)
-                /static.#artifact_extension ".class"]]
+(def: (lux_compiler it)
+  (-> Any platform.Custom)
+  (as_expected it))
+
+(program: [service cli.service]
+  (let [context (context.jvm (cli.target service))]
     (exec (do async.monad
-            [[loader platform] (async.future ..platform)
-             _ (/.compiler [/static.#host @.jvm
-                            /static.#host_module_extension ".jvm"
-                            /static.#target (/cli.target service)
-                            /static.#artifact_extension ".class"]
-                           ..expander
-                           (analysis.bundle loader)
-                           (io.io platform)
-                           ... generation.bundle
-                           translation.bundle
-                           (|>> ..extender (directive.bundle loader))
-                           (jvm/program.program jvm/runtime.class_name)
-                           [_.Anchor _.Inst _.Definition]
-                           ..extender
-                           service
-                           [(packager.package static)
-                            (format (/cli.target service) (# file.default separator) "program.jar")])]
+            [[loader host platform] (async.future ..platform)
+             _ (compositor.compiler
+                ..lux_compiler
+                context
+                ..expander
+                (analysis.bundle loader host)
+                (io.io platform)
+                generation.bundle
+                (|>> ..extender (directive.bundle loader))
+                (/program.program /runtime.class_name)
+                [Anchor (type (Bytecode Any)) Definition]
+                ..extender
+                service
+                [(packager.package context)
+                 (format (cli.target service) (# file.default separator) "program.jar")])]
             (..declare_success! []))
       (io.io []))))