aboutsummaryrefslogtreecommitdiff
path: root/lux-lua
diff options
context:
space:
mode:
Diffstat (limited to 'lux-lua')
-rw-r--r--lux-lua/source/program.lux205
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)