Used new Function interface to fix directives bug in JVM compiler.

1 files changed, 96 insertions, 92 deletions

diff --git a/lux-jvm/source/program.lux b/lux-jvm/source/program.lux
index b4710d116..61593c215 100644
--- a/lux-jvm/source/program.lux
+++ b/lux-jvm/source/program.lux
@@ -127,104 +127,108 @@
               (ffi.write! 1 (:as java/lang/Object lux)))
           apply_method))))
 
-(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)
+... 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))))
+...         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)))))}))
+...         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)))))}))
 
 (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)))))))
+    [... 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))))
+        )))
 
 (def: .public platform
   ... (IO (Platform Anchor (Bytecode Any) Definition))