aboutsummaryrefslogtreecommitdiff
path: root/lux-lua/source
diff options
context:
space:
mode:
authorEduardo Julian2021-02-04 01:30:34 -0400
committerEduardo Julian2021-02-04 01:30:34 -0400
commit571d816dfd0b056a1649f5057867abbfa4421f5d (patch)
treecccd86f9285bf4956d6b50aea669ad4e9e15ee13 /lux-lua/source
parent3d457763e34d4dd1992427b3918b351ac684adb7 (diff)
Updates for Lua compiler.
Diffstat (limited to 'lux-lua/source')
-rw-r--r--lux-lua/source/program.lux514
1 files changed, 308 insertions, 206 deletions
diff --git a/lux-lua/source/program.lux b/lux-lua/source/program.lux
index 2851fec7d..63cc376d8 100644
--- a/lux-lua/source/program.lux
+++ b/lux-lua/source/program.lux
@@ -1,163 +1,190 @@
(.module:
[lux #*
+ [program (#+ program:)]
+ ["." host]
[abstract
["." monad (#+ do)]]
[control
- pipe
- [cli (#+ program:)]
- ["p" parser]
+ ["." try (#+ Try)]
["." exception (#+ exception:)]
- ["." io (#+ IO io)]]
+ ["." io (#+ IO io)]
+ [concurrency
+ ["." promise (#+ Promise)]]]
[data
["." maybe]
- ["." error (#+ Error)]
- [number
- ["." i64]]
- ["." text ("#@." hash)
- format]
+ ["." text ("#\." hash)
+ ["%" format (#+ format)]
+ ["." encoding]]
[collection
- ["." array (#+ Array)]
- ["." list ("#@." functor)]]]
- ["." macro
- ["s" syntax (#+ syntax:)]
- ["." code]
+ ["." array (#+ Array)]]]
+ [macro
["." template]]
- [world
- ["." file]]
- ["." host (#+ import: interface: do-to object)
+ [math
+ [number
+ ["n" nat]
+ ["." i64]]]
+ ["." world #_
+ ["." file]
+ ["#/." program]]
+ ["@" target
["_" lua]]
[tool
[compiler
- ["." name]
- ["." synthesis]
- [phase
- [macro (#+ Expander)]
- ["." generation
- ["." lua
- ["." runtime]
- ["." extension]]]]
+ [phase (#+ Operation Phase)]
+ [reference
+ [variable (#+ Register)]]
+ [language
+ [lux
+ [program (#+ Program)]
+ [generation (#+ Context Host)]
+ [analysis
+ [macro (#+ Expander)]]
+ [phase
+ ["." extension (#+ Extender Handler)
+ ["#/." bundle]
+ ["." analysis #_
+ ["#" lua]]
+ ["." generation #_
+ ["#" lua]]]
+ [generation
+ ["." reference]
+ ["." lua
+ ["." runtime]]]]]]
[default
- ["." platform (#+ Platform)]]]]]
+ ["." platform (#+ Platform)]]
+ [meta
+ ["." packager #_
+ ["#" script]]]]]]
[program
["/" compositor
- ["/." cli]]])
+ ["#." cli]
+ ["#." static]]])
-(import: #long java/lang/String)
+(host.import: java/lang/String)
-(import: #long (java/lang/Class a))
+(host.import: (java/lang/Class a))
-(import: #long java/lang/Object
- (toString [] java/lang/String)
- (getClass [] (java/lang/Class java/lang/Object)))
+(host.import: java/lang/Object
+ ["#::."
+ (toString [] java/lang/String)
+ (getClass [] (java/lang/Class java/lang/Object))])
-(import: #long java/lang/Long
- (intValue [] java/lang/Integer))
+(host.import: java/lang/Long
+ ["#::."
+ (intValue [] java/lang/Integer)])
-(import: #long net/sandius/rembulan/StateContext)
+(host.import: net/sandius/rembulan/StateContext)
-(import: #long net/sandius/rembulan/impl/StateContexts
- (#static newDefaultInstance [] net/sandius/rembulan/StateContext))
+(host.import: net/sandius/rembulan/impl/StateContexts
+ ["#::."
+ (#static newDefaultInstance [] net/sandius/rembulan/StateContext)])
-(import: #long net/sandius/rembulan/env/RuntimeEnvironment)
+(host.import: net/sandius/rembulan/env/RuntimeEnvironment)
-(import: #long net/sandius/rembulan/env/RuntimeEnvironments
- (#static system [] net/sandius/rembulan/env/RuntimeEnvironment))
+(host.import: net/sandius/rembulan/env/RuntimeEnvironments
+ ["#::."
+ (#static system [] net/sandius/rembulan/env/RuntimeEnvironment)])
-(import: #long net/sandius/rembulan/Table
- (rawget #as get-idx [long] #? java/lang/Object)
- (rawget #as get-key [java/lang/Object] #? java/lang/Object)
- (rawlen [] long))
+(host.import: net/sandius/rembulan/Table
+ ["#::."
+ (rawget #as get_idx [long] #? java/lang/Object)
+ (rawget #as get_key [java/lang/Object] #? java/lang/Object)
+ (rawlen [] long)])
-(import: #long net/sandius/rembulan/ByteString
- (decode [] java/lang/String))
+(host.import: net/sandius/rembulan/ByteString
+ ["#::."
+ (decode [] java/lang/String)])
-(import: #long net/sandius/rembulan/impl/DefaultTable)
+(host.import: net/sandius/rembulan/impl/DefaultTable)
-(import: #long net/sandius/rembulan/impl/ImmutableTable)
+(host.import: net/sandius/rembulan/impl/ImmutableTable)
-(import: #long net/sandius/rembulan/impl/ImmutableTable$Builder
- (new [])
- (build [] net/sandius/rembulan/impl/ImmutableTable))
+(host.import: net/sandius/rembulan/impl/ImmutableTable$Builder
+ ["#::."
+ (new [])
+ (build [] net/sandius/rembulan/impl/ImmutableTable)])
-(import: #long net/sandius/rembulan/lib/StandardLibrary
- (#static in [net/sandius/rembulan/env/RuntimeEnvironment] net/sandius/rembulan/lib/StandardLibrary)
- (installInto [net/sandius/rembulan/StateContext] net/sandius/rembulan/Table))
+(host.import: net/sandius/rembulan/lib/StandardLibrary
+ ["#::."
+ (#static in [net/sandius/rembulan/env/RuntimeEnvironment] net/sandius/rembulan/lib/StandardLibrary)
+ (installInto [net/sandius/rembulan/StateContext] net/sandius/rembulan/Table)])
-(import: #long net/sandius/rembulan/Variable
- (new [java/lang/Object]))
+(host.import: net/sandius/rembulan/Variable
+ ["#::."
+ (new [java/lang/Object])])
-(import: #long net/sandius/rembulan/runtime/LuaFunction)
+(host.import: net/sandius/rembulan/runtime/LuaFunction)
-(import: #long net/sandius/rembulan/load/ChunkLoader
- (loadTextChunk [net/sandius/rembulan/Variable
- java/lang/String
- java/lang/String]
- net/sandius/rembulan/runtime/LuaFunction))
+(host.import: net/sandius/rembulan/load/ChunkLoader
+ ["#::."
+ (loadTextChunk [net/sandius/rembulan/Variable
+ java/lang/String
+ java/lang/String]
+ net/sandius/rembulan/runtime/LuaFunction)])
-(import: #long net/sandius/rembulan/compiler/CompilerChunkLoader
- (#static of [java/lang/String] net/sandius/rembulan/compiler/CompilerChunkLoader))
+(host.import: net/sandius/rembulan/compiler/CompilerChunkLoader
+ ["#::."
+ (#static of [java/lang/String] net/sandius/rembulan/compiler/CompilerChunkLoader)])
-(import: #long net/sandius/rembulan/runtime/SchedulingContext)
+(host.import: net/sandius/rembulan/runtime/SchedulingContext)
-(import: #long net/sandius/rembulan/runtime/SchedulingContextFactory)
+(host.import: net/sandius/rembulan/runtime/SchedulingContextFactory)
-(import: #long net/sandius/rembulan/exec/DirectCallExecutor
- (#static newExecutor [] net/sandius/rembulan/exec/DirectCallExecutor)
- (schedulingContextFactory [] net/sandius/rembulan/runtime/SchedulingContextFactory)
- (call [net/sandius/rembulan/StateContext java/lang/Object [java/lang/Object]] #try [java/lang/Object]))
+(host.import: net/sandius/rembulan/exec/DirectCallExecutor
+ ["#::."
+ (#static newExecutor [] net/sandius/rembulan/exec/DirectCallExecutor)
+ (schedulingContextFactory [] net/sandius/rembulan/runtime/SchedulingContextFactory)
+ (call [net/sandius/rembulan/StateContext java/lang/Object [java/lang/Object]] #try [java/lang/Object])])
-(exception: (unknown-kind-of-object {object java/lang/Object})
+(exception: (unknown_kind_of_object {object java/lang/Object})
(exception.report
["Class" (java/lang/Object::toString (java/lang/Object::getClass object))]
["Object" (java/lang/Object::toString object)]))
(template [<name>]
- [(interface: <name>
+ [(host.interface: <name>
(getValue [] java/lang/Object))
- (`` (import: #long (~~ (template.identifier ["program/" <name>]))
- (getValue [] java/lang/Object)))]
+ (`` (host.import: (~~ (template.identifier ["program/" <name>]))
+ ["#::."
+ (getValue [] java/lang/Object)]))]
[StructureValue]
)
-(def: (lux-structure value)
+(def: (lux_structure value)
(-> (Array java/lang/Object) program/StructureValue)
- (let [re-wrap (function (_ unwrapped)
+ (let [re_wrap (function (_ unwrapped)
(case (host.check [java/lang/Object] unwrapped)
- (#.Some sub-value)
- (|> sub-value (:coerce (Array java/lang/Object)) lux-structure (:coerce java/lang/Object))
+ (#.Some sub_value)
+ (|> sub_value (:coerce (Array java/lang/Object)) lux_structure (:coerce java/lang/Object))
#.None
unwrapped))]
- (object [] net/sandius/rembulan/impl/DefaultTable [program/StructureValue]
+ (host.object [] net/sandius/rembulan/impl/DefaultTable [program/StructureValue]
[]
## Methods
(program/StructureValue
- (getValue)
- java/lang/Object
+ [] (getValue self) java/lang/Object
(:coerce (Array java/lang/Object) value))
(net/sandius/rembulan/impl/DefaultTable
- (rawlen)
- long
+ [] (rawlen self) long
(|> value array.size (:coerce java/lang/Long)))
(net/sandius/rembulan/impl/DefaultTable
- (rawget {idx long})
- java/lang/Object
- (|> value (array.read (|> idx (:coerce Nat) dec)) maybe.assume re-wrap))
+ [] (rawget self {idx long}) java/lang/Object
+ (|> value (array.read (|> idx (:coerce Nat) dec)) maybe.assume re_wrap))
(net/sandius/rembulan/impl/DefaultTable
- (rawget {field java/lang/Object})
- java/lang/Object
+ [] (rawget self {field java/lang/Object}) java/lang/Object
(case (host.check net/sandius/rembulan/ByteString field)
(#.Some field)
(case (net/sandius/rembulan/ByteString::decode field)
- (^ (static runtime.variant-tag-field))
+ (^ (static runtime.variant_tag_field))
(|> value (array.read 0) maybe.assume)
- (^ (static runtime.variant-flag-field))
+ (^ (static runtime.variant_flag_field))
(case (array.read 1 value)
(#.Some _)
""
@@ -165,161 +192,159 @@
#.None
(host.null))
- (^ (static runtime.variant-value-field))
- (|> value (array.read 2) maybe.assume re-wrap)
+ (^ (static runtime.variant_value_field))
+ (|> value (array.read 2) maybe.assume re_wrap)
_
- (error! (exception.construct unknown-kind-of-object field)))
+ (error! (exception.construct ..unknown_kind_of_object field)))
#.None
(case (host.check java/lang/Long field)
(#.Some idx)
- (|> value (array.read (|> idx (:coerce Nat) dec)) maybe.assume re-wrap)
+ (|> value (array.read (|> idx (:coerce Nat) dec)) maybe.assume re_wrap)
#.None
- (error! (exception.construct unknown-kind-of-object field)))))
+ (error! (exception.construct ..unknown_kind_of_object field)))))
)))
(type: Translator
- (-> java/lang/Object (Error Any)))
+ (-> java/lang/Object (Try Any)))
-(def: (read-variant read host-object)
- (-> Translator net/sandius/rembulan/impl/DefaultTable (Error Any))
- (case [(net/sandius/rembulan/Table::get-key runtime.variant-tag-field host-object)
- (net/sandius/rembulan/Table::get-key runtime.variant-flag-field host-object)
- (net/sandius/rembulan/Table::get-key runtime.variant-value-field host-object)]
+(def: (read_variant read host_object)
+ (-> Translator net/sandius/rembulan/impl/DefaultTable (Try Any))
+ (case [(net/sandius/rembulan/Table::get_key runtime.variant_tag_field host_object)
+ (net/sandius/rembulan/Table::get_key runtime.variant_flag_field host_object)
+ (net/sandius/rembulan/Table::get_key runtime.variant_value_field host_object)]
(^multi [(#.Some tag) ?flag (#.Some value)]
[(read value)
(#.Some value)])
- (#error.Success [(java/lang/Long::intValue (:coerce java/lang/Long tag))
- (: Any (case ?flag (#.Some _) "" #.None (host.null)))
- value])
+ (#try.Success [(java/lang/Long::intValue (:coerce java/lang/Long tag))
+ (: Any (case ?flag (#.Some _) "" #.None (host.null)))
+ value])
_
- (exception.throw ..unknown-kind-of-object host-object)))
+ (exception.throw ..unknown_kind_of_object host_object)))
-(def: (read-tuple read host-object)
- (-> Translator net/sandius/rembulan/impl/DefaultTable (Error Any))
- (let [init-num-keys (.nat (net/sandius/rembulan/Table::rawlen host-object))]
- (loop [num-keys init-num-keys
+(def: (read_tuple read host_object)
+ (-> Translator net/sandius/rembulan/impl/DefaultTable (Try Any))
+ (let [init_num_keys (.nat (net/sandius/rembulan/Table::rawlen host_object))]
+ (loop [num_keys init_num_keys
idx 0
output (: (Array java/lang/Object)
- (array.new init-num-keys))]
- (if (n/< num-keys idx)
- (case (net/sandius/rembulan/Table::get-idx (:coerce java/lang/Long (inc idx)) host-object)
+ (array.new init_num_keys))]
+ (if (n.< num_keys idx)
+ (case (net/sandius/rembulan/Table::get_idx (:coerce java/lang/Long (inc idx)) host_object)
#.None
- (recur num-keys (inc idx) output)
+ (recur num_keys (inc idx) output)
(#.Some member)
(case (read member)
- (#error.Success parsed-member)
- (recur num-keys (inc idx) (array.write idx (:coerce java/lang/Object parsed-member) output))
+ (#try.Success parsed_member)
+ (recur num_keys (inc idx) (array.write! idx (:coerce java/lang/Object parsed_member) output))
- (#error.Failure error)
- (#error.Failure error)))
- (#error.Success output)))))
+ (#try.Failure error)
+ (#try.Failure error)))
+ (#try.Success output)))))
-(exception: #export nil-has-no-lux-representation)
+(exception: #export nil_has_no_lux_representation)
-(def: (read host-object)
+(def: (read host_object)
Translator
- (`` (<| (if (host.null? host-object)
- (exception.throw nil-has-no-lux-representation []))
- (~~ (template [<class> <post-processing>]
- [(case (host.check <class> host-object)
- (#.Some typed-object)
- (|> typed-object <post-processing>)
+ (`` (<| (if (host.null? host_object)
+ (exception.throw ..nil_has_no_lux_representation []))
+ (~~ (template [<class> <post_processing>]
+ [(case (host.check <class> host_object)
+ (#.Some typed_object)
+ (|> typed_object <post_processing>)
_)]
- [java/lang/Boolean #error.Success]
- [java/lang/Long #error.Success]
- [java/lang/Double #error.Success]
- [java/lang/String #error.Success]
- [net/sandius/rembulan/runtime/LuaFunction #error.Success]
- [net/sandius/rembulan/ByteString (<| #error.Success net/sandius/rembulan/ByteString::decode)]
- [program/StructureValue (<| #error.Success program/StructureValue::getValue)]
+ [java/lang/Boolean #try.Success]
+ [java/lang/Long #try.Success]
+ [java/lang/Double #try.Success]
+ [java/lang/String #try.Success]
+ [net/sandius/rembulan/runtime/LuaFunction #try.Success]
+ [net/sandius/rembulan/ByteString (<| #try.Success net/sandius/rembulan/ByteString::decode)]
+ [program/StructureValue (<| #try.Success program/StructureValue::getValue)]
))
- (case (host.check net/sandius/rembulan/impl/DefaultTable host-object)
- (#.Some typed-object)
- (case (read-variant read typed-object)
- (#error.Success value)
- (#error.Success value)
+ (case (host.check net/sandius/rembulan/impl/DefaultTable host_object)
+ (#.Some typed_object)
+ (case (read_variant read typed_object)
+ (#try.Success value)
+ (#try.Success value)
- (#error.Failure error)
- (case (read-tuple read typed-object)
- (#error.Success value)
- (#error.Success value)
+ (#try.Failure error)
+ (case (read_tuple read typed_object)
+ (#try.Success value)
+ (#try.Success value)
- (#error.Failure error)
- (exception.throw ..unknown-kind-of-object host-object)))
+ (#try.Failure error)
+ (exception.throw ..unknown_kind_of_object host_object)))
_
- (exception.throw ..unknown-kind-of-object host-object))
+ (exception.throw ..unknown_kind_of_object host_object))
)))
-(exception: (cannot-apply-a-non-function {object java/lang/Object})
+(exception: (cannot_apply_a_non_function {object java/lang/Object})
(exception.report
["Non-function" (java/lang/Object::toString object)]))
-(def: ensure-macro
+(def: ensure_function
(-> Macro (Maybe net/sandius/rembulan/runtime/LuaFunction))
(|>> (:coerce java/lang/Object) (host.check net/sandius/rembulan/runtime/LuaFunction)))
-(type: Baggage [net/sandius/rembulan/StateContext net/sandius/rembulan/exec/DirectCallExecutor])
+(type: Baggage
+ [net/sandius/rembulan/StateContext
+ net/sandius/rembulan/exec/DirectCallExecutor])
-(def: (call-macro [state-context executor] inputs lux macro)
- (-> Baggage (List Code) Lux net/sandius/rembulan/runtime/LuaFunction (Error Any))
- (do error.monad
- [output (net/sandius/rembulan/exec/DirectCallExecutor::call state-context
+(def: (call_macro [state_context executor] inputs lux macro)
+ (-> Baggage (List Code) Lux net/sandius/rembulan/runtime/LuaFunction (Try Any))
+ (do try.monad
+ [output (net/sandius/rembulan/exec/DirectCallExecutor::call state_context
(:coerce java/lang/Object macro)
(|> (array.new 2)
- (array.write 0 ## (:coerce java/lang/Object inputs)
- ## (net/sandius/rembulan/impl/ImmutableTable$Builder::build (net/sandius/rembulan/impl/ImmutableTable$Builder::new))
- (:coerce java/lang/Object (lux-structure (:coerce (Array java/lang/Object) inputs))))
- (array.write 1 ## (:coerce java/lang/Object lux)
- ## (net/sandius/rembulan/impl/ImmutableTable$Builder::build (net/sandius/rembulan/impl/ImmutableTable$Builder::new))
- (:coerce java/lang/Object (lux-structure (:coerce (Array java/lang/Object) lux)))))
+ (array.write! 0 ## (:coerce java/lang/Object inputs)
+ ## (net/sandius/rembulan/impl/ImmutableTable$Builder::build (net/sandius/rembulan/impl/ImmutableTable$Builder::new))
+ (:coerce java/lang/Object (lux_structure (:coerce (Array java/lang/Object) inputs))))
+ (array.write! 1 ## (:coerce java/lang/Object lux)
+ ## (net/sandius/rembulan/impl/ImmutableTable$Builder::build (net/sandius/rembulan/impl/ImmutableTable$Builder::new))
+ (:coerce java/lang/Object (lux_structure (:coerce (Array java/lang/Object) lux)))))
executor)]
(wrap (|> output (array.read 0) maybe.assume (:coerce java/lang/Object) ..read))))
(def: (expander baggage macro inputs lux)
(-> Baggage Expander)
- (case (ensure-macro macro)
+ (case (..ensure_function macro)
(#.Some macro)
- (case (call-macro baggage inputs lux macro)
- (#error.Success output)
+ (case (call_macro baggage inputs lux macro)
+ (#try.Success output)
(|> output
- (:coerce (Error (Error [Lux (List Code)]))))
+ (:coerce (Try (Try [Lux (List Code)]))))
- (#error.Failure error)
- (#error.Failure error))
+ (#try.Failure error)
+ (#try.Failure error))
#.None
- (exception.throw cannot-apply-a-non-function (:coerce java/lang/Object macro)))
- )
+ (exception.throw ..cannot_apply_a_non_function (:coerce java/lang/Object macro))))
(def: separator "___")
-(type: Host
- (generation.Host (_.Expression Any) _.Statement))
-
(def: host
- (IO [Baggage Host])
- (io (let [runtime-env (net/sandius/rembulan/env/RuntimeEnvironments::system)
- std-lib (net/sandius/rembulan/lib/StandardLibrary::in runtime-env)
- state-context (net/sandius/rembulan/impl/StateContexts::newDefaultInstance)
- table (net/sandius/rembulan/lib/StandardLibrary::installInto state-context std-lib)
+ (IO [Baggage (Host _.Expression _.Statement)])
+ (io (let [runtime_env (net/sandius/rembulan/env/RuntimeEnvironments::system)
+ std_lib (net/sandius/rembulan/lib/StandardLibrary::in runtime_env)
+ state_context (net/sandius/rembulan/impl/StateContexts::newDefaultInstance)
+ table (net/sandius/rembulan/lib/StandardLibrary::installInto state_context std_lib)
variable (net/sandius/rembulan/Variable::new table)
loader (net/sandius/rembulan/compiler/CompilerChunkLoader::of "_lux_definition")
executor (net/sandius/rembulan/exec/DirectCallExecutor::newExecutor)
- scheduling-context (net/sandius/rembulan/exec/DirectCallExecutor::schedulingContextFactory executor)
- run! (: (-> Text _.Statement (Error Any))
- (function (_ dummy-name code)
- (do error.monad
- [#let [lua-function (net/sandius/rembulan/load/ChunkLoader::loadTextChunk variable "lux compilation" (_.code code)
+ scheduling_context (net/sandius/rembulan/exec/DirectCallExecutor::schedulingContextFactory executor)
+ run! (: (-> _.Statement (Try Any))
+ (function (_ code)
+ (do try.monad
+ [#let [lua_function (net/sandius/rembulan/load/ChunkLoader::loadTextChunk variable "lux compilation" (_.code code)
loader)]
- output (net/sandius/rembulan/exec/DirectCallExecutor::call state-context (:coerce java/lang/Object lua-function) (array.new 0)
+ output (net/sandius/rembulan/exec/DirectCallExecutor::call state_context (:coerce java/lang/Object lua_function) (array.new 0)
executor)]
(case (array.read 0 output)
#.None
@@ -327,45 +352,122 @@
(#.Some value)
(read value)))))]
- [[state-context executor]
- (: Host
+ [[state_context executor]
+ (: (Host _.Expression _.Statement)
(structure
- (def: (evaluate! dummy-name code)
- (run! dummy-name (_.return code)))
+ (def: (evaluate! context code)
+ (run! (_.return code)))
+
(def: execute! run!)
- (def: (define! [module name] input)
- (let [global (format (text.replace-all .module-separator ..separator module)
- ..separator (name.normalize name)
- "___" (%n (text@hash name)))
+
+ (def: (define! context input)
+ (let [global (reference.artifact context)
@global (_.var global)]
- (do error.monad
+ (do try.monad
[#let [definition (_.set (list @global) input)]
- _ (run! global definition)
- value (run! global (_.return @global))]
- (wrap [global value definition]))))))])))
+ _ (run! definition)
+ value (run! (_.return @global))]
+ (wrap [global value definition]))))
+
+ (def: (ingest context content)
+ (|> content (\ encoding.utf8 decode) try.assume (:coerce _.Statement)))
+
+ (def: (re_learn context content)
+ (run! content))
+
+ (def: (re_load context content)
+ (do try.monad
+ [_ (run! content)]
+ (run! (_.return (_.var (reference.artifact context))))))))])))
(def: platform
- (IO [Baggage (Platform IO _.Var (_.Expression Any) _.Statement)])
+ (IO [Baggage (Platform _.Var _.Expression _.Statement)])
(do io.monad
[[baggage host] ..host]
(wrap [baggage
- {#platform.&monad io.monad
- #platform.&file-system file.system
+ {#platform.&file_system (file.async file.default)
#platform.host host
#platform.phase lua.generate
- #platform.runtime runtime.generate}])))
+ #platform.runtime runtime.generate
+ #platform.write (|>> _.code (\ encoding.utf8 encode))}])))
-(def: (program program)
- (-> (_.Expression Any) _.Statement)
- (_.statement (_.apply/* (list (runtime.lux//program-args (_.var "arg"))
+(def: (program context program)
+ (Program _.Expression _.Statement)
+ (_.statement (_.apply/* (list (runtime.lux//program_args (_.var "arg"))
_.nil)
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)))
+
+(def: scope
+ (-> _.Statement _.Statement)
+ (|>> (_.closure (list))
+ (_.apply/* (list))
+ _.statement))
+
(program: [{service /cli.service}]
- (do io.monad
- [[baggage platform] ..platform]
- (/.compiler (..expander baggage)
- (io platform)
- extension.bundle
- ..program
- service)))
+ (let [extension ".lua"]
+ (do io.monad
+ [[baggage platform] ..platform]
+ (exec (do promise.monad
+ [_ (/.compiler {#/static.host @.lua
+ #/static.host_module_extension extension
+ #/static.target (/cli.target service)
+ #/static.artifact_extension extension}
+ (..expander baggage)
+ analysis.bundle
+ (io.io platform)
+ generation.bundle
+ extension/bundle.empty
+ ..program
+ [_.Var _.Expression _.Statement]
+ (..extender baggage)
+ service
+ [(packager.package (_.manual "") _.code _.then ..scope)
+ (format (/cli.target service)
+ (\ file.default separator)
+ "program"
+ extension)])]
+ (..declare_success! []))
+ (io.io [])))))