diff options
Diffstat (limited to 'lux-lua')
| -rw-r--r-- | lux-lua/source/program.lux | 205 |
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) |