(.module: [lux #* [program (#+ program:)] ["." host] [abstract ["." monad (#+ do)]] [control ["." try (#+ Try)] ["." exception (#+ exception:)] ["." io (#+ IO io)] [concurrency ["." promise (#+ Promise)]]] [data ["." maybe] ["." text ("#\." hash) ["%" format (#+ format)] ["." encoding]] [collection ["." array (#+ Array)]]] [macro ["." template]] [math [number ["n" nat] ["." i64]]] ["." world #_ ["." file] ["#/." program]] ["@" target ["_" lua]] [tool [compiler [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)]] [meta ["." packager #_ ["#" script]]]]]] [program ["/" compositor ["#." cli] ["#." static]]]) (for {@.old (as_is (host.import: java/lang/String) (host.import: (java/lang/Class a)) (host.import: java/lang/Object ["#::." (toString [] java/lang/String) (getClass [] (java/lang/Class java/lang/Object))]) (host.import: java/lang/Long ["#::." (intValue [] java/lang/Integer)]) (host.import: net/sandius/rembulan/StateContext) (host.import: net/sandius/rembulan/impl/StateContexts ["#::." (#static newDefaultInstance [] net/sandius/rembulan/StateContext)]) (host.import: net/sandius/rembulan/env/RuntimeEnvironment) (host.import: net/sandius/rembulan/env/RuntimeEnvironments ["#::." (#static system [] net/sandius/rembulan/env/RuntimeEnvironment)]) (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)]) (host.import: net/sandius/rembulan/ByteString ["#::." (decode [] java/lang/String)]) (host.import: net/sandius/rembulan/impl/DefaultTable) (host.import: net/sandius/rembulan/impl/ImmutableTable) (host.import: net/sandius/rembulan/impl/ImmutableTable$Builder ["#::." (new []) (build [] net/sandius/rembulan/impl/ImmutableTable)]) (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)]) (host.import: net/sandius/rembulan/Variable ["#::." (new [java/lang/Object])]) (host.import: net/sandius/rembulan/runtime/LuaFunction) (host.import: net/sandius/rembulan/load/ChunkLoader ["#::." (loadTextChunk [net/sandius/rembulan/Variable java/lang/String java/lang/String] #try net/sandius/rembulan/runtime/LuaFunction)]) (host.import: net/sandius/rembulan/compiler/CompilerChunkLoader ["#::." (#static of [java/lang/String] net/sandius/rembulan/compiler/CompilerChunkLoader)]) (host.import: net/sandius/rembulan/runtime/SchedulingContext) (host.import: net/sandius/rembulan/runtime/SchedulingContextFactory) (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.report ["Class" (java/lang/Object::toString (java/lang/Object::getClass object))] ["Object" (java/lang/Object::toString object)])) (template [] [(host.interface: (getValue [] java/lang/Object)) (`` (host.import: (~~ (template.identifier ["program/" ])) ["#::." (getValue [] java/lang/Object)]))] [StructureValue] ) (def: (lux_structure value) (-> (Array java/lang/Object) program/StructureValue) (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)) #.None unwrapped))] (host.object [] net/sandius/rembulan/impl/DefaultTable [program/StructureValue] [] ## Methods (program/StructureValue [] (getValue self) java/lang/Object (:coerce (Array java/lang/Object) value)) (net/sandius/rembulan/impl/DefaultTable [] (rawlen self) long (|> value array.size (:coerce java/lang/Long))) (net/sandius/rembulan/impl/DefaultTable [] (rawget self {idx long}) java/lang/Object (|> value (array.read (|> idx (:coerce Nat) dec)) maybe.assume re_wrap)) (net/sandius/rembulan/impl/DefaultTable [] (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)) (|> value (array.read 0) maybe.assume) (^ (static runtime.variant_flag_field)) (case (array.read 1 value) (#.Some _) "" #.None (host.null)) (^ (static runtime.variant_value_field)) (|> value (array.read 2) maybe.assume re_wrap) _ (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) #.None (error! (exception.construct ..unknown_kind_of_object field))))) ))) (type: Translator (-> java/lang/Object (Try Any))) (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)]) (#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))) (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) #.None (recur num_keys (inc idx) output) (#.Some member) (case (read member) (#try.Success parsed_member) (recur num_keys (inc idx) (array.write! idx (:coerce java/lang/Object parsed_member) output)) (#try.Failure error) (#try.Failure error))) (#try.Success output))))) (exception: #export nil_has_no_lux_representation) (def: (read host_object) Translator (`` (<| (if (host.null? host_object) (exception.throw ..nil_has_no_lux_representation [])) (~~ (template [ ] [(case (host.check host_object) (#.Some typed_object) (|> typed_object ) _)] [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) (#try.Success value) (#try.Success value) (#try.Failure error) (read_tuple read typed_object)) _) (exception.throw ..unknown_kind_of_object host_object) ))) (exception: (cannot_apply_a_non_function {object java/lang/Object}) (exception.report ["Non-function" (java/lang/Object::toString object)])) (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]) (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))))) executor)] (|> output (array.read 0) maybe.assume (:coerce java/lang/Object) ..read))) (def: (expander baggage macro inputs lux) (-> Baggage Expander) (case (..ensure_function macro) (#.Some macro) (case (..call_macro baggage inputs lux macro) (#try.Success output) (|> output (:coerce (Try [Lux (List Code)])) #try.Success) (#try.Failure error) (#try.Failure error)) #.None (exception.throw ..cannot_apply_a_non_function (:coerce java/lang/Object macro))))) @.lua (def: (expander macro inputs lux) Expander (#try.Success ((:coerce Macro' macro) inputs lux)))}) (for {@.old (def: host (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! (: (-> _.Statement (Try Any)) (function (_ code) (do try.monad [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) executor)] (case (array.read 0 output) #.None (wrap []) (#.Some value) (read value)))))] [[state_context executor] (: (Host _.Expression _.Statement) (structure (def: (evaluate! context code) (run! (_.return code))) (def: execute! run!) (def: (define! context input) (let [global (reference.artifact context) @global (_.var global)] (do try.monad [#let [definition (_.set (list @global) input)] _ (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))))))))]))) @.lua (as_is (host.import: (load [host.String] #try host.Function)) (def: host (IO (Host _.Expression _.Statement)) (io (let [run! (: (-> _.Statement (Try Any)) (function (_ code) (do try.monad [lua_function (..load (_.code code))] (let [output ("lua apply" lua_function)] (#try.Success (if ("lua object nil?" output) [] output))))))] (: (Host _.Expression _.Statement) (structure (def: (evaluate! context code) (run! (_.return code))) (def: execute! run!) (def: (define! context input) (let [global (reference.artifact context) @global (_.var global)] (do try.monad [#let [definition (_.set (list @global) input)] _ (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))))))))))))}) (for {@.old (def: platform (IO [Baggage (Platform [Register _.Label] _.Expression _.Statement)]) (do io.monad [[baggage host] ..host] (wrap [baggage {#platform.&file_system (file.async file.default) #platform.host host #platform.phase lua.generate #platform.runtime runtime.generate #platform.write (|>> _.code (\ encoding.utf8 encode))}]))) @.lua (def: platform (IO (Platform [Register _.Label] _.Expression _.Statement)) (do io.monad [host ..host] (wrap {#platform.&file_system (file.async file.default) #platform.host host #platform.phase lua.generate #platform.runtime runtime.generate #platform.write (|>> _.code (\ encoding.utf8 encode))})))}) (def: (program context program) (Program _.Expression _.Statement) (let [$program (_.var (reference.artifact context))] (_.statement (_.apply/* (list (runtime.lux//program_args (_.var "arg")) 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))) (`` (program: [{service /cli.service}] (let [extension ".lua"] (do io.monad [(~~ (for {@.old [baggage platform] @.lua platform})) ..platform] (exec (do promise.monad [_ (/.compiler {#/static.host @.lua #/static.host_module_extension extension #/static.target (/cli.target service) #/static.artifact_extension extension} (for {@.old (..expander baggage) @.lua ..expander}) analysis.bundle (io.io platform) generation.bundle extension/bundle.empty ..program [(& Register _.Label) _.Expression _.Statement] (for {@.old (..extender baggage) @.lua ..extender}) service [(packager.package (_.manual "") _.code _.then (|>>)) (format (/cli.target service) (\ file.default separator) "program" extension)])] (..declare_success! [])) (io.io []))))))