Made sure the "phase" parameter of extensions is always usable (even across language boundaries)

1 files changed, 163 insertions, 42 deletions

diff --git a/lux-lua/source/program.lux b/lux-lua/source/program.lux
index 40a076e27..6eb8d8485 100644
--- a/lux-lua/source/program.lux
+++ b/lux-lua/source/program.lux
@@ -8,6 +8,7 @@
     ["." try (#+ Try)]
     ["." exception (#+ exception:)]
     ["." io (#+ IO io)]
+    ["." function]
     [concurrency
      ["." promise (#+ Promise)]]]
    [data
@@ -17,7 +18,8 @@
      [encoding
       ["." utf8]]]
     [collection
-     ["." array (#+ Array)]]]
+     ["." array (#+ Array)]
+     ["." list]]]
    [macro
     ["." template]]
    [math
@@ -31,7 +33,7 @@
     ["_" lua]]
    [tool
     [compiler
-     [phase (#+ Operation Phase)]
+     ["." phase (#+ Operation Phase)]
      [reference
       [variable (#+ Register)]]
      [language
@@ -54,6 +56,7 @@
      [default
       ["." platform (#+ Platform)]]
      [meta
+      [archive (#+ Archive)]
       ["." packager #_
        ["#" script]]]]]]
   [program
@@ -115,6 +118,14 @@
                ["#::."
                 (new [java/lang/Object])])
 
+             (ffi.import: net/sandius/rembulan/runtime/ReturnBuffer
+               ["#::."
+                (setTo [java/lang/Object] void)])
+             
+             (ffi.import: net/sandius/rembulan/runtime/ExecutionContext
+               ["#::."
+                (getReturnBuffer [] net/sandius/rembulan/runtime/ReturnBuffer)])
+             
              (ffi.import: net/sandius/rembulan/runtime/LuaFunction)
 
              (ffi.import: net/sandius/rembulan/load/ChunkLoader
@@ -606,6 +617,153 @@
                                    [_ (run! content)]
                                    (run! (_.return (_.var (reference.artifact context))))))))))))})
 
+(for {@.old
+      (as_is (exception: #export (invaid_phase_application {partial_application (List Any)}
+                                                           {arity Nat})
+               (exception.report
+                ["Partial Application" (%.nat (list.size partial_application))]
+                ["Arity" (%.nat arity)]))
+
+             (def: to_host
+               (-> Any java/lang/Object)
+               (|>> (:coerce (Array java/lang/Object)) ..lux_structure (:coerce java/lang/Object)))
+
+             (def: (return ec value)
+               (-> net/sandius/rembulan/runtime/ExecutionContext Any Any)
+               (|> ec
+                   net/sandius/rembulan/runtime/ExecutionContext::getReturnBuffer
+                   (net/sandius/rembulan/runtime/ReturnBuffer::setTo (:coerce java/lang/Object value))))
+
+             (def: (host_phase partial_application phase)
+               (All [s i o]
+                 (-> (List Any) (Phase [extension.Bundle s] i o)
+                     java/lang/Object))
+               (ffi.object [] net/sandius/rembulan/runtime/LuaFunction []
+                 []
+                 ## Methods
+                 (net/sandius/rembulan/runtime/LuaFunction
+                  [] (invoke self
+                             {% net/sandius/rembulan/runtime/ExecutionContext})
+                  void
+                  (<| (..return %)
+                      (host_phase partial_application phase)))
+
+                 (net/sandius/rembulan/runtime/LuaFunction
+                  [] (invoke self
+                             {% net/sandius/rembulan/runtime/ExecutionContext}
+                             {input/0 java/lang/Object})
+                  void
+                  (<| (..return %)
+                      try.assume
+                      (do try.monad
+                        [input/0 (..read input/0)]
+                        (case partial_application
+                          (^ (list partial/0 partial/1))
+                          (wrap (..to_host ((:coerce (-> Any Any Any Any) phase)
+                                            partial/0
+                                            partial/1
+                                            input/0)))
+
+                          (^ (list partial/0))
+                          (wrap (host_phase (list partial/0 input/0) phase))
+                          
+                          (^ (list))
+                          (wrap (host_phase (list input/0) phase))
+
+                          _
+                          (exception.throw ..invaid_phase_application [partial_application 2])))))
+
+                 (net/sandius/rembulan/runtime/LuaFunction
+                  [] (invoke self
+                             {% net/sandius/rembulan/runtime/ExecutionContext}
+                             {input/0 java/lang/Object}
+                             {input/1 java/lang/Object})
+                  void
+                  (<| (..return %)
+                      try.assume
+                      (do try.monad
+                        [input/0 (..read input/0)
+                         input/1 (..read input/1)]
+                        (case partial_application
+                          (^ (list partial/0))
+                          (wrap (..to_host ((:coerce (-> Any Any Any Any) phase)
+                                            partial/0
+                                            input/0
+                                            input/1)))
+                          
+                          (^ (list))
+                          (wrap (host_phase (list input/0 input/1) phase))
+
+                          _
+                          (exception.throw ..invaid_phase_application [partial_application 2])))))
+
+                 (net/sandius/rembulan/runtime/LuaFunction
+                  [] (invoke self
+                             {% net/sandius/rembulan/runtime/ExecutionContext}
+                             {input/0 java/lang/Object}
+                             {input/1 java/lang/Object}
+                             {input/2 java/lang/Object})
+                  void
+                  (<| (..return %)
+                      try.assume
+                      (do try.monad
+                        [input/0 (..read input/0)
+                         input/1 (..read input/1)
+                         input/2 (..read input/2)]
+                        (case partial_application
+                          (^ (list))
+                          (wrap (..to_host ((:coerce (-> Any Any Any Any) phase)
+                                            input/0
+                                            input/1
+                                            input/2)))
+                          
+                          _
+                          (exception.throw ..invaid_phase_application [partial_application 3])))))))
+
+             (def: (extender [state_context executor] phase_wrapper)
+               (-> Baggage (-> platform.Phase_Wrapper Extender))
+               ## TODO: Stop relying on coercions ASAP.
+               (<| (:coerce Extender)
+                   (function (@self handler))
+                   (:coerce Handler)
+                   (function (@self name phase))
+                   (:coerce Phase)
+                   (function (@self archive parameters))
+                   (:coerce Operation)
+                   (function (@self state))
+                   (:coerce Try)
+                   try.assume
+                   (:coerce Try)
+                   (do try.monad
+                     [handler (try.from_maybe (..ensure_function handler))
+                      output (net/sandius/rembulan/exec/DirectCallExecutor::call state_context
+                                                                                 (:coerce java/lang/Object handler)
+                                                                                 (|> (array.new 5)
+                                                                                     (array.write! 0 name)
+                                                                                     (array.write! 1 (:coerce java/lang/Object (phase_wrapper phase)))
+                                                                                     (array.write! 2 (..to_host archive))
+                                                                                     (array.write! 3 (..to_host parameters))
+                                                                                     (array.write! 4 (..to_host state)))
+                                                                                 executor)]
+                     (|> output
+                         (array.read 0)
+                         maybe.assume
+                         (:coerce java/lang/Object)
+                         ..read)))))
+
+      @.lua
+      (def: (extender phase_wrapper handler)
+        (-> platform.Phase_Wrapper Extender)
+        (:assume handler))})
+
+(def: (phase_wrapper archive)
+  (-> Archive (runtime.Operation platform.Phase_Wrapper))
+  (do phase.monad
+    []
+    (wrap (:coerce platform.Phase_Wrapper
+                   (for {@.old (..host_phase (list))
+                         @.lua (|>>)})))))
+
 (for {@.old (def: platform
               (IO [Baggage (Platform [Register _.Label] _.Expression _.Statement)])
               (do io.monad
@@ -615,6 +773,7 @@
                         #platform.host host
                         #platform.phase lua.generate
                         #platform.runtime runtime.generate
+                        #platform.phase_wrapper ..phase_wrapper
                         #platform.write (|>> _.code (\ utf8.codec encode))}])))
       @.lua (def: platform
               (IO (Platform [Register _.Label] _.Expression _.Statement))
@@ -624,6 +783,7 @@
                        #platform.host host
                        #platform.phase lua.generate
                        #platform.runtime runtime.generate
+                       #platform.phase_wrapper ..phase_wrapper
                        #platform.write (|>> _.code (\ utf8.codec encode))})))})
 
 (def: (program context program)
@@ -633,45 +793,6 @@
                                   runtime.unit)
                             program))))
 
-(for {@.old
-      (def: (extender [state_context executor])
-        (-> Baggage Extender)
-        ## TODO: Stop relying on coercions ASAP.
-        (<| (:coerce Extender)
-            (function (@self handler))
-            (:coerce Handler)
-            (function (@self name phase))
-            (:coerce Phase)
-            (function (@self archive parameters))
-            (:coerce Operation)
-            (function (@self state))
-            (:coerce Try)
-            try.assume
-            (:coerce Try)
-            (do try.monad
-              [handler (try.from_maybe (..ensure_function handler))
-               #let [to_lua (: (-> Any java/lang/Object)
-                               (|>> (:coerce (Array java/lang/Object)) lux_structure (:coerce java/lang/Object)))]
-               output (net/sandius/rembulan/exec/DirectCallExecutor::call state_context
-                                                                          (:coerce java/lang/Object handler)
-                                                                          (|> (array.new 5)
-                                                                              (array.write! 0 name)
-                                                                              (array.write! 1 (to_lua phase))
-                                                                              (array.write! 2 (to_lua archive))
-                                                                              (array.write! 3 (to_lua parameters))
-                                                                              (array.write! 4 (to_lua state)))
-                                                                          executor)]
-              (|> output
-                  (array.read 0)
-                  maybe.assume
-                  (:coerce java/lang/Object)
-                  ..read))))
-
-      @.lua
-      (def: (extender handler)
-        Extender
-        (:assume handler))})
-
 (def: (declare_success! _)
   (-> Any (Promise Any))
   (promise.future (\ world/program.default exit +0)))
@@ -692,7 +813,7 @@
                                  analysis.bundle
                                  (io.io platform)
                                  generation.bundle
-                                 extension/bundle.empty
+                                 (function.constant extension/bundle.empty)
                                  ..program
                                  [(& Register _.Label) _.Expression _.Statement]
                                  (for {@.old (..extender baggage)