diff options
Diffstat (limited to 'lux-lua/source')
| -rw-r--r-- | lux-lua/source/program.lux | 1438 |
1 files changed, 727 insertions, 711 deletions
diff --git a/lux-lua/source/program.lux b/lux-lua/source/program.lux index 4667088cb..c5c03f32a 100644 --- a/lux-lua/source/program.lux +++ b/lux-lua/source/program.lux @@ -65,729 +65,740 @@ ["#." cli] ["#." static]]]) -(for {@.old - (as_is (ffi.import: java/lang/String) +(with_expansions [<jvm> (as_is (ffi.import: java/lang/String) - (ffi.import: (java/lang/Class a)) - - (ffi.import: java/lang/Object - ["#::." - (toString [] java/lang/String) - (getClass [] (java/lang/Class java/lang/Object))]) - - (ffi.import: java/lang/Long - ["#::." - (intValue [] java/lang/Integer)]) - - (ffi.import: net/sandius/rembulan/StateContext) - - (ffi.import: net/sandius/rembulan/impl/StateContexts - ["#::." - (#static newDefaultInstance [] net/sandius/rembulan/StateContext)]) - - (ffi.import: net/sandius/rembulan/env/RuntimeEnvironment) - - (ffi.import: net/sandius/rembulan/env/RuntimeEnvironments - ["#::." - (#static system [] net/sandius/rembulan/env/RuntimeEnvironment)]) - - (ffi.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)]) - - (ffi.import: net/sandius/rembulan/ByteString - ["#::." - (decode [] java/lang/String)]) - - (ffi.import: net/sandius/rembulan/impl/DefaultTable) - - (ffi.import: net/sandius/rembulan/impl/ImmutableTable) - - (ffi.import: net/sandius/rembulan/impl/ImmutableTable$Builder - ["#::." - (new []) - (build [] net/sandius/rembulan/impl/ImmutableTable)]) - - (ffi.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)]) - - (ffi.import: net/sandius/rembulan/Variable - ["#::." - (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 - ["#::." - (loadTextChunk [net/sandius/rembulan/Variable - java/lang/String - java/lang/String] - #try net/sandius/rembulan/runtime/LuaFunction)]) - - (ffi.import: net/sandius/rembulan/compiler/CompilerChunkLoader - ["#::." - (#static of [java/lang/String] net/sandius/rembulan/compiler/CompilerChunkLoader)]) - - (ffi.import: net/sandius/rembulan/runtime/SchedulingContext) - - (ffi.import: net/sandius/rembulan/runtime/SchedulingContextFactory) - - (ffi.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 [<name>] - [(ffi.interface: <name> - (getValue [] java/lang/Object)) - - (`` (ffi.import: (~~ (template.identifier ["program/" <name>])) - ["#::." - (getValue [] java/lang/Object)]))] - - [StructureValue] - ) - - (def: (lux_structure value) - (-> (Array java/lang/Object) program/StructureValue) - (let [re_wrap (function (_ unwrapped) - (case (ffi.check [java/lang/Object] unwrapped) - (#.Some sub_value) - (|> sub_value (:as (Array java/lang/Object)) lux_structure (:as java/lang/Object)) - - #.None - unwrapped))] - (ffi.object [] net/sandius/rembulan/impl/DefaultTable [program/StructureValue] - [] - ... Methods - (program/StructureValue - [] (getValue self) java/lang/Object - (:as (Array java/lang/Object) value)) - - (net/sandius/rembulan/impl/DefaultTable - [] (rawlen self) long - (|> value array.size (:as java/lang/Long))) - - (net/sandius/rembulan/impl/DefaultTable - [] (rawget self {idx long}) java/lang/Object - (|> value (array.read! (|> idx (:as Nat) --)) maybe.trusted re_wrap)) - - (net/sandius/rembulan/impl/DefaultTable - [] (rawget self {field java/lang/Object}) java/lang/Object - (case (ffi.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.trusted) - - (^ (static runtime.variant_flag_field)) - (case (array.read! 1 value) - (#.Some _) - "" - - #.None - (ffi.null)) - - (^ (static runtime.variant_value_field)) - (|> value (array.read! 2) maybe.trusted re_wrap) - - _ - (panic! (exception.construct ..unknown_kind_of_object field))) - - #.None - (case (ffi.check java/lang/Long field) - (#.Some idx) - (|> value (array.read! (|> idx (:as Nat) --)) maybe.trusted re_wrap) - - #.None - (panic! (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 (:as java/lang/Long tag)) - (: Any (case ?flag (#.Some _) "" #.None (ffi.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 (:as java/lang/Long (++ idx)) host_object) - #.None - (recur num_keys (++ idx) output) - - (#.Some member) - (case (read member) - (#try.Success parsed_member) - (recur num_keys (++ idx) (array.write! idx (:as java/lang/Object parsed_member) output)) - - (#try.Failure error) - (#try.Failure error))) - (#try.Success output))))) - - (exception: .public nil_has_no_lux_representation) - - (def: (read host_object) - Translator - (`` (<| (if (ffi.null? host_object) - (exception.throw ..nil_has_no_lux_representation [])) - (~~ (template [<class> <post_processing>] - [(case (ffi.check <class> host_object) - (#.Some typed_object) - (|> typed_object <post_processing>) - - _)] - - [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 (ffi.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)) - (|>> (:as java/lang/Object) (ffi.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 - (:as java/lang/Object macro) - (|> (array.new 2) - (array.write! 0 ... (:as java/lang/Object inputs) - ... (net/sandius/rembulan/impl/ImmutableTable$Builder::build (net/sandius/rembulan/impl/ImmutableTable$Builder::new)) - (:as java/lang/Object (lux_structure (:as (Array java/lang/Object) inputs)))) - (array.write! 1 ... (:as java/lang/Object lux) - ... (net/sandius/rembulan/impl/ImmutableTable$Builder::build (net/sandius/rembulan/impl/ImmutableTable$Builder::new)) - (:as java/lang/Object (lux_structure (:as (Array java/lang/Object) lux))))) - executor)] - (|> output (array.read! 0) maybe.trusted (:as 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 - (:as (Try [Lux (List Code)])) - #try.Success) - - (#try.Failure error) - (#try.Failure error)) - - #.None - (exception.throw ..cannot_apply_a_non_function (:as java/lang/Object macro))))) - - @.lua - (def: (expander macro inputs lux) - Expander - (#try.Success ((:as Macro' macro) inputs lux)))}) - -(for {@.old (as_is (with_expansions [$var_args (_.var "...") - $str_rel_to_abs (_.var "_utf8_str_rel_to_abs") - $decode (_.var "_utf8_decode")] - (template.let [(!int <hex>) - [(_.int (.int (hex <hex>)))] - - (!&| <or> <and> <raw>) - [(|> <raw> - (_.bit_and (!int <and>)) - (_.bit_or (!int <or>)))] - - (!&|< <or> <and> <shift> <raw>) - [(|> <raw> - (_.bit_shr (_.int <shift>)) - (_.bit_and (!int <and>)) - (_.bit_or (!int <or>)))]] - (as_is (def: rembulan//char - (let [$buffer (_.var "buffer") - $k (_.var "k") - $v (_.var "v") - $b1 (_.var "b1") - $b2 (_.var "b2") - $b3 (_.var "b3") - $b4 (_.var "b4") - table/insert (_.apply/2 (_.var "table.insert"))] - (_.function (_.var "utf8.char") (list $var_args) - ($_ _.then - (_.local/1 $buffer (_.array (list))) - (<| (_.for_in (list $k $v) (_.ipairs/1 (_.array (list $var_args)))) - ($_ _.then - (_.when (_.or (_.< (_.int +0) $v) - (_.> (!int "10FFFF") $v)) - (_.statement (_.error/2 (|> (_.string "bad argument #") - (_.concat $k) - (_.concat (_.string " to char (out of range)"))) - (_.int +2)))) - (<| (_.if (_.< (!int "80") $v) - ... Single-byte sequence - (_.statement (|> (_.var "string.char") - (_.apply/* (list $v)) - (table/insert $buffer)))) - (_.if (_.< (!int "800") $v) - ... Two-byte sequence - (_.statement (|> (_.var "string.char") - (_.apply/* (list (!&|< "C0" "1F" +6 $v) - (!&| "80" "3F" $v))) - (table/insert $buffer)))) - (_.if (_.< (!int "10000") $v) - ... Three-byte sequence - (_.statement (|> (_.var "string.char") - (_.apply/* (list (!&|< "E0" "0F" +12 $v) - (!&|< "80" "3F" +6 $v) - (!&| "80" "3F" $v))) - (table/insert $buffer)))) - ... Four-byte sequence - (_.statement (|> (_.var "string.char") - (_.apply/* (list (!&|< "F0" "07" +18 $v) - (!&|< "80" "3F" +12 $v) - (!&|< "80" "3F" +6 $v) - (!&| "80" "3F" $v))) - (table/insert $buffer)))) - )) - (_.return (_.apply/2 (_.var "table.concat") $buffer (_.string ""))) - )))) - - ... (def: rembulan//str_rel_to_abs - ... (let [$string (_.var "string") - ... $args (_.var "args") - ... $k (_.var "k") - ... $v (_.var "v")] - ... (<| (_.local_function $str_rel_to_abs (list $string $var_args)) - ... ($_ _.then - ... (_.local/1 $args (_.array (list $var_args))) - ... (<| (_.for_in (list $k $v) (_.ipairs/1 $args)) - ... ($_ _.then - ... (_.if (_.> (_.int +0) $v) - ... (_.set (list $v) $v) - ... (_.set (list $v) (|> $v (_.+ (_.length $string)) (_.+ (_.int +1))))) - ... (_.when (_.or (_.< (_.int +1) $v) - ... (_.> (_.length $string) $v)) - ... (_.statement (_.error/2 (_.string "bad index to string (out of range)") (_.int +3)))) - ... (_.set (list (_.nth $k $args)) $v))) - ... (_.return (_.apply/1 (_.var "table.unpack") $args)) - ... )))) - - ... (def: rembulan//decode - ... (let [$string (_.var "string") - ... $start (_.var "start") - ... $b1 (_.var "b1") - ... $idx (_.var "idx") - ... $bx (_.var "bx") - ... $end (_.var "_end")] - ... (<| (_.local_function $decode (list $string $start)) - ... ($_ _.then - ... (_.set (list $start) (_.apply/2 $str_rel_to_abs $string (_.or (_.int +1) $start))) - ... (_.local/1 $b1 (_.do "byte" (list $start $start) $string)) - ... (<| (_.if (_.< (!int "80") $b1) - ... ... Single-byte sequence - ... (_.return (_.multi (list $start $start)))) - ... ... Validate first byte of multi-byte sequence - ... (_.if (_.or (_.> (!int "F4") $b1) - ... (_.< (!int "C2") $b1)) - ... (_.return _.nil)) - ... ... Get 'supposed' amount of continuation bytes from primary byte - ... ($_ _.then - ... (_.local/1 $end (|> (|> $b1 (_.>= (!int "F0")) (_.and (_.int +3))) - ... (_.or (|> $b1 (_.>= (!int "E0")) (_.and (_.int +2)))) - ... (_.or (|> $b1 (_.>= (!int "C0")) (_.and (_.int +1)))) - ... (_.+ $start))) - ... ... Validate our continuation bytes - ... (<| (_.for_in (list $idx $bx) (_.ipairs/1 (_.array (list (_.do "byte" - ... (list (_.+ (_.int +1) $start) $end) - ... $string))))) - ... (_.when (|> $bx - ... (_.bit_and (!int "C0")) - ... (_.= (!int "80")) - ... _.not) - ... (_.return _.nil))) - ... (_.return (_.multi (list $start $end))) - ... )) - ... )))) - - ... (def: rembulan//codes - ... (let [$string (_.var "string") - ... $i (_.var "i") - ... $start (_.var "start") - ... $end (_.var "_end")] - ... (_.function (_.var "utf8.codes") (list $string) - ... ($_ _.then - ... (_.local/1 $i (_.int +1)) - ... (_.return (<| (_.closure (list)) - ... (_.if (_.> (_.length $string) $i) - ... (_.return _.nil) - ... ($_ _.then - ... (_.let (list $start $end) (_.apply/2 $decode $string $i)) - ... (_.if (_.not $start) - ... (_.statement (_.error/2 (_.string "invalid UTF-8 code") (_.int +2))) - ... ($_ _.then - ... (_.set (list $i) (_.+ (_.int +1) $end)) - ... (_.return (_.multi (list $start (_.do "sub" (list $start $end) $string)))) - ... )) - ... )))) - ... )))) - - ... (def: rembulan//len - ... (let [$string (_.var "string") - ... $start (_.var "start") - ... $end (_.var "_end") - ... $seq_start (_.var "seq_start") - ... $seq_end (_.var "seq_end") - ... $size (_.var "size")] - ... (_.function (_.var "utf8.len") (list $string $start $end) - ... ($_ _.then - ... (_.set (list $start $end) (_.apply/3 $str_rel_to_abs $string (_.or (_.int +1) $start) (_.or (_.int -1) $end))) - ... (_.local/1 $size (_.int +0)) - ... (_.repeat (_.>= $end $seq_end) - ... ($_ _.then - ... (_.let (list $seq_start $seq_end) (_.apply/2 $decode $string $start)) - ... (_.if (_.not $seq_start) - ... ... Hit an invalid sequence! - ... (_.return (_.multi (list (_.bool false) $start))) - ... ($_ _.then - ... (_.set (list $start) (_.+ (_.int +1) $seq_end)) - ... (_.set (list $size) (_.+ (_.int +1) $size)) - ... )) - ... )) - ... (_.return $size) - ... )))) - - ... (def: rembulan//charpattern - ... (_.set (list (_.var "utf8.charpattern")) - ... (_.string "[%z\x01-\x7F\xC2-\xF4][\x80-\xBF]*"))) - - (def: rembulan_prelude - _.Statement - ($_ _.then - (_.function (_.var "os.time") (list) - (_.return (_.int +0))) - - ... Ported from https://github.com/meepen/Lua-5.1-UTF-8 - ..rembulan//char - ... ..rembulan//str_rel_to_abs - ... ..rembulan//decode - ... ..rembulan//codes - ... ..rembulan//len - ... ..rembulan//charpattern - ))))) - - (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 (:as java/lang/Object lua_function) (array.new 0) - executor)] - (case (array.read! 0 output) - #.None - (wrap []) - - (#.Some value) - (read value))))) - _ (try.trusted (run! ..rembulan_prelude))] - [[state_context executor] - (: (Host _.Expression _.Statement) - (implementation - (def: (evaluate! context code) - (run! (_.return code))) - - (def: execute! run!) - - (def: (define! context custom input) - (let [global (maybe.default (reference.artifact context) - custom) - @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 (\ utf8.codec decoded) try.trusted (:as _.Statement))) - - (def: (re_learn context custom content) - (run! content)) - - (def: (re_load context custom content) - (do try.monad - [_ (run! content)] - (run! (_.return (_.var (reference.artifact context))))))))])))) - @.lua (as_is (ffi.import: (load [ffi.String] #try ffi.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) - (implementation - (def: (evaluate! context code) - (run! (_.return code))) - - (def: execute! run!) - - (def: (define! context custom input) - (let [global (maybe.default (reference.artifact context) - custom) - @global (_.var global)] - (do try.monad - [#let [definition (_.set (list @global) input)] - _ (run! definition) - value (run! (_.return @global))] - (wrap [global value definition])))) + (ffi.import: (java/lang/Class a)) + + (ffi.import: java/lang/Object + ["#::." + (toString [] java/lang/String) + (getClass [] (java/lang/Class java/lang/Object))]) + + (ffi.import: java/lang/Long + ["#::." + (intValue [] java/lang/Integer)]) + + (ffi.import: net/sandius/rembulan/StateContext) + + (ffi.import: net/sandius/rembulan/impl/StateContexts + ["#::." + (#static newDefaultInstance [] net/sandius/rembulan/StateContext)]) + + (ffi.import: net/sandius/rembulan/env/RuntimeEnvironment) + + (ffi.import: net/sandius/rembulan/env/RuntimeEnvironments + ["#::." + (#static system [] net/sandius/rembulan/env/RuntimeEnvironment)]) + + (ffi.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)]) + + (ffi.import: net/sandius/rembulan/ByteString + ["#::." + (decode [] java/lang/String)]) - (def: (ingest context content) - (|> content (\ utf8.codec decoded) try.trusted (:as _.Statement))) + (ffi.import: net/sandius/rembulan/impl/DefaultTable) - (def: (re_learn context custom content) - (run! content)) + (ffi.import: net/sandius/rembulan/impl/ImmutableTable) + + (ffi.import: net/sandius/rembulan/impl/ImmutableTable$Builder + ["#::." + (new []) + (build [] net/sandius/rembulan/impl/ImmutableTable)]) + + (ffi.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)]) + + (ffi.import: net/sandius/rembulan/Variable + ["#::." + (new [java/lang/Object])]) + + (ffi.import: net/sandius/rembulan/runtime/ReturnBuffer + ["#::." + (setTo [java/lang/Object] void)]) - (def: (re_load context custom content) + (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 + ["#::." + (loadTextChunk [net/sandius/rembulan/Variable + java/lang/String + java/lang/String] + #try net/sandius/rembulan/runtime/LuaFunction)]) + + (ffi.import: net/sandius/rembulan/compiler/CompilerChunkLoader + ["#::." + (#static of [java/lang/String] net/sandius/rembulan/compiler/CompilerChunkLoader)]) + + (ffi.import: net/sandius/rembulan/runtime/SchedulingContext) + + (ffi.import: net/sandius/rembulan/runtime/SchedulingContextFactory) + + (ffi.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 [<name>] + [(ffi.interface: <name> + (getValue [] java/lang/Object)) + + (`` (ffi.import: (~~ (template.identifier ["program/" <name>])) + ["#::." + (getValue [] java/lang/Object)]))] + + [StructureValue] + ) + + (def: (lux_structure value) + (-> (Array java/lang/Object) program/StructureValue) + (let [re_wrap (: (-> java/lang/Object java/lang/Object) + (function (_ unwrapped) + (case (ffi.check [java/lang/Object] unwrapped) + (#.Some sub_value) + (|> sub_value (:as (Array java/lang/Object)) lux_structure (:as java/lang/Object)) + + #.None + unwrapped)))] + (:as program/StructureValue + (ffi.object [] net/sandius/rembulan/impl/DefaultTable [program/StructureValue] + [] + ... Methods + (program/StructureValue + [] (getValue self) java/lang/Object + (:as java/lang/Object value)) + + (net/sandius/rembulan/impl/DefaultTable + [] (rawlen self) long + (|> value array.size (:as java/lang/Long))) + + (net/sandius/rembulan/impl/DefaultTable + [] (rawget self {idx long}) java/lang/Object + (|> value (array.read! (|> idx (:as Nat) --)) maybe.trusted re_wrap)) + + (net/sandius/rembulan/impl/DefaultTable + [] (rawget self {field java/lang/Object}) java/lang/Object + (case (ffi.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.trusted) + + (^ (static runtime.variant_flag_field)) + (case (array.read! 1 value) + (#.Some _) + (:as java/lang/Object "") + + #.None + (ffi.null)) + + (^ (static runtime.variant_value_field)) + (|> value (array.read! 2) maybe.trusted re_wrap) + + _ + (panic! (exception.error ..unknown_kind_of_object [(:as java/lang/Object field)]))) + + #.None + (case (ffi.check java/lang/Long field) + (#.Some idx) + (|> value (array.read! (|> idx (:as Nat) --)) maybe.trusted re_wrap) + + #.None + (panic! (exception.error ..unknown_kind_of_object [(:as java/lang/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 (:as java/lang/Object runtime.variant_tag_field) host_object) + (net/sandius/rembulan/Table::get_key (:as java/lang/Object runtime.variant_flag_field) host_object) + (net/sandius/rembulan/Table::get_key (:as java/lang/Object runtime.variant_value_field) host_object)] + (^multi [(#.Some tag) ?flag (#.Some value)] + {(read value) + (#try.Success value)}) + (#try.Success [(: Any (|> tag (:as java/lang/Long) java/lang/Long::intValue)) + (: Any (case ?flag + (#.Some _) (: Any "") + #.None (:as Any (ffi.null)))) + (: Any value)]) + + _ + (exception.except ..unknown_kind_of_object [(:as java/lang/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.empty init_num_keys))] + (if (n.< num_keys idx) + (case (net/sandius/rembulan/Table::get_idx (:as java/lang/Long (++ idx)) host_object) + #.None + (recur num_keys (++ idx) output) + + (#.Some member) + (case (read member) + (#try.Success parsed_member) + (recur num_keys (++ idx) (array.write! idx (:as java/lang/Object parsed_member) output)) + + (#try.Failure error) + (#try.Failure error))) + (#try.Success output))))) + + (exception: .public nil_has_no_lux_representation) + + (def: (read host_object) + Translator + (`` (<| (if (ffi.null? host_object) + (exception.except ..nil_has_no_lux_representation [])) + (~~ (template [<class> <post_processing>] + [(case (ffi.check <class> host_object) + (#.Some typed_object) + (|> typed_object <post_processing>) + + _)] + + [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 (ffi.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.except ..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)) + (|>> (:as java/lang/Object) (ffi.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 - [_ (run! content)] - (run! (_.return (_.var (reference.artifact context))))))))))))}) - -(for {@.old - (as_is (exception: .public (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) - (|>> (:as (Array java/lang/Object)) ..lux_structure (:as 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 (:as 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.trusted - (do try.monad - [input/0 (..read input/0)] - (case partial_application - (^ (list partial/0 partial/1)) - (wrap (..to_host ((:as (-> 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.trusted - (do try.monad - [input/0 (..read input/0) - input/1 (..read input/1)] - (case partial_application - (^ (list partial/0)) - (wrap (..to_host ((:as (-> 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.trusted - (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 ((:as (-> 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. - (<| (:as Extender) - (function (@self handler)) - (:as Handler) - (function (@self name phase)) - (:as Phase) - (function (@self archive parameters)) - (:as Operation) - (function (@self state)) - (:as Try) - try.trusted - (:as Try) - (do try.monad - [handler (try.of_maybe (..ensure_function handler)) - output (net/sandius/rembulan/exec/DirectCallExecutor::call state_context - (:as java/lang/Object handler) - (|> (array.new 5) - (array.write! 0 name) - (array.write! 1 (:as 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.trusted - (:as java/lang/Object) - ..read))))) - - @.lua - (def: (extender phase_wrapper handler) - (-> platform.Phase_Wrapper Extender) - (:expected handler))}) + [output (net/sandius/rembulan/exec/DirectCallExecutor::call state_context + (:as java/lang/Object macro) + (|> (array.empty 2) + (array.write! 0 ... (:as java/lang/Object inputs) + ... (net/sandius/rembulan/impl/ImmutableTable$Builder::build (net/sandius/rembulan/impl/ImmutableTable$Builder::new)) + (:as java/lang/Object (lux_structure (:as (Array java/lang/Object) inputs)))) + (array.write! 1 ... (:as java/lang/Object lux) + ... (net/sandius/rembulan/impl/ImmutableTable$Builder::build (net/sandius/rembulan/impl/ImmutableTable$Builder::new)) + (:as java/lang/Object (lux_structure (:as (Array java/lang/Object) lux))))) + executor)] + (|> output (array.read! 0) maybe.trusted (:as 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 + (:as (Try [Lux (List Code)])) + #try.Success) + + (#try.Failure error) + (#try.Failure error)) + + #.None + (exception.except ..cannot_apply_a_non_function (:as java/lang/Object macro)))))] + (for {@.old (as_is <jvm>) + @.jvm (as_is <jvm>) + + @.lua + (def: (expander macro inputs lux) + Expander + (#try.Success ((:as Macro' macro) inputs lux)))})) + +(with_expansions [<jvm> (as_is (with_expansions [$var_args (_.var "...") + $str_rel_to_abs (_.var "_utf8_str_rel_to_abs") + $decode (_.var "_utf8_decode")] + (template.let [(!int <hex>) + [(_.int (.int (hex <hex>)))] + + (!&| <or> <and> <raw>) + [(|> <raw> + (_.bit_and (!int <and>)) + (_.bit_or (!int <or>)))] + + (!&|< <or> <and> <shift> <raw>) + [(|> <raw> + (_.bit_shr (_.int <shift>)) + (_.bit_and (!int <and>)) + (_.bit_or (!int <or>)))]] + (as_is (def: rembulan//char + (let [$buffer (_.var "buffer") + $k (_.var "k") + $v (_.var "v") + $b1 (_.var "b1") + $b2 (_.var "b2") + $b3 (_.var "b3") + $b4 (_.var "b4") + table/insert (_.apply/2 (_.var "table.insert"))] + (_.function (_.var "utf8.char") (list $var_args) + ($_ _.then + (_.local/1 $buffer (_.array (list))) + (<| (_.for_in (list $k $v) (_.ipairs/1 (_.array (list $var_args)))) + ($_ _.then + (_.when (_.or (_.< (_.int +0) $v) + (_.> (!int "10FFFF") $v)) + (_.statement (_.error/2 (|> (_.string "bad argument #") + (_.concat $k) + (_.concat (_.string " to char (out of range)"))) + (_.int +2)))) + (<| (_.if (_.< (!int "80") $v) + ... Single-byte sequence + (_.statement (|> (_.var "string.char") + (_.apply/* (list $v)) + (table/insert $buffer)))) + (_.if (_.< (!int "800") $v) + ... Two-byte sequence + (_.statement (|> (_.var "string.char") + (_.apply/* (list (!&|< "C0" "1F" +6 $v) + (!&| "80" "3F" $v))) + (table/insert $buffer)))) + (_.if (_.< (!int "10000") $v) + ... Three-byte sequence + (_.statement (|> (_.var "string.char") + (_.apply/* (list (!&|< "E0" "0F" +12 $v) + (!&|< "80" "3F" +6 $v) + (!&| "80" "3F" $v))) + (table/insert $buffer)))) + ... Four-byte sequence + (_.statement (|> (_.var "string.char") + (_.apply/* (list (!&|< "F0" "07" +18 $v) + (!&|< "80" "3F" +12 $v) + (!&|< "80" "3F" +6 $v) + (!&| "80" "3F" $v))) + (table/insert $buffer)))) + )) + (_.return (_.apply/2 (_.var "table.concat") $buffer (_.string ""))) + )))) + + ... (def: rembulan//str_rel_to_abs + ... (let [$string (_.var "string") + ... $args (_.var "args") + ... $k (_.var "k") + ... $v (_.var "v")] + ... (<| (_.local_function $str_rel_to_abs (list $string $var_args)) + ... ($_ _.then + ... (_.local/1 $args (_.array (list $var_args))) + ... (<| (_.for_in (list $k $v) (_.ipairs/1 $args)) + ... ($_ _.then + ... (_.if (_.> (_.int +0) $v) + ... (_.set (list $v) $v) + ... (_.set (list $v) (|> $v (_.+ (_.length $string)) (_.+ (_.int +1))))) + ... (_.when (_.or (_.< (_.int +1) $v) + ... (_.> (_.length $string) $v)) + ... (_.statement (_.error/2 (_.string "bad index to string (out of range)") (_.int +3)))) + ... (_.set (list (_.nth $k $args)) $v))) + ... (_.return (_.apply/1 (_.var "table.unpack") $args)) + ... )))) + + ... (def: rembulan//decode + ... (let [$string (_.var "string") + ... $start (_.var "start") + ... $b1 (_.var "b1") + ... $idx (_.var "idx") + ... $bx (_.var "bx") + ... $end (_.var "_end")] + ... (<| (_.local_function $decode (list $string $start)) + ... ($_ _.then + ... (_.set (list $start) (_.apply/2 $str_rel_to_abs $string (_.or (_.int +1) $start))) + ... (_.local/1 $b1 (_.do "byte" (list $start $start) $string)) + ... (<| (_.if (_.< (!int "80") $b1) + ... ... Single-byte sequence + ... (_.return (_.multi (list $start $start)))) + ... ... Validate first byte of multi-byte sequence + ... (_.if (_.or (_.> (!int "F4") $b1) + ... (_.< (!int "C2") $b1)) + ... (_.return _.nil)) + ... ... Get 'supposed' amount of continuation bytes from primary byte + ... ($_ _.then + ... (_.local/1 $end (|> (|> $b1 (_.>= (!int "F0")) (_.and (_.int +3))) + ... (_.or (|> $b1 (_.>= (!int "E0")) (_.and (_.int +2)))) + ... (_.or (|> $b1 (_.>= (!int "C0")) (_.and (_.int +1)))) + ... (_.+ $start))) + ... ... Validate our continuation bytes + ... (<| (_.for_in (list $idx $bx) (_.ipairs/1 (_.array (list (_.do "byte" + ... (list (_.+ (_.int +1) $start) $end) + ... $string))))) + ... (_.when (|> $bx + ... (_.bit_and (!int "C0")) + ... (_.= (!int "80")) + ... _.not) + ... (_.return _.nil))) + ... (_.return (_.multi (list $start $end))) + ... )) + ... )))) + + ... (def: rembulan//codes + ... (let [$string (_.var "string") + ... $i (_.var "i") + ... $start (_.var "start") + ... $end (_.var "_end")] + ... (_.function (_.var "utf8.codes") (list $string) + ... ($_ _.then + ... (_.local/1 $i (_.int +1)) + ... (_.return (<| (_.closure (list)) + ... (_.if (_.> (_.length $string) $i) + ... (_.return _.nil) + ... ($_ _.then + ... (_.let (list $start $end) (_.apply/2 $decode $string $i)) + ... (_.if (_.not $start) + ... (_.statement (_.error/2 (_.string "invalid UTF-8 code") (_.int +2))) + ... ($_ _.then + ... (_.set (list $i) (_.+ (_.int +1) $end)) + ... (_.return (_.multi (list $start (_.do "sub" (list $start $end) $string)))) + ... )) + ... )))) + ... )))) + + ... (def: rembulan//len + ... (let [$string (_.var "string") + ... $start (_.var "start") + ... $end (_.var "_end") + ... $seq_start (_.var "seq_start") + ... $seq_end (_.var "seq_end") + ... $size (_.var "size")] + ... (_.function (_.var "utf8.len") (list $string $start $end) + ... ($_ _.then + ... (_.set (list $start $end) (_.apply/3 $str_rel_to_abs $string (_.or (_.int +1) $start) (_.or (_.int -1) $end))) + ... (_.local/1 $size (_.int +0)) + ... (_.repeat (_.>= $end $seq_end) + ... ($_ _.then + ... (_.let (list $seq_start $seq_end) (_.apply/2 $decode $string $start)) + ... (_.if (_.not $seq_start) + ... ... Hit an invalid sequence! + ... (_.return (_.multi (list (_.bool false) $start))) + ... ($_ _.then + ... (_.set (list $start) (_.+ (_.int +1) $seq_end)) + ... (_.set (list $size) (_.+ (_.int +1) $size)) + ... )) + ... )) + ... (_.return $size) + ... )))) + + ... (def: rembulan//charpattern + ... (_.set (list (_.var "utf8.charpattern")) + ... (_.string "[%z\x01-\x7F\xC2-\xF4][\x80-\xBF]*"))) + + (def: rembulan_prelude + _.Statement + ($_ _.then + (_.function (_.var "os.time") (list) + (_.return (_.int +0))) + + ... Ported from https://github.com/meepen/Lua-5.1-UTF-8 + ..rembulan//char + ... ..rembulan//str_rel_to_abs + ... ..rembulan//decode + ... ..rembulan//codes + ... ..rembulan//len + ... ..rembulan//charpattern + ))))) + + (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 (:as java/lang/Object lua_function) (array.empty 0) + executor)] + (case (array.read! 0 output) + #.None + (in []) + + (#.Some value) + (read value))))) + _ (try.trusted (run! ..rembulan_prelude))] + [[state_context executor] + (: (Host _.Expression _.Statement) + (implementation + (def: (evaluate! context code) + (run! (_.return code))) + + (def: execute! run!) + + (def: (define! context custom input) + (let [global (maybe.else (reference.artifact context) + custom) + @global (_.var global)] + (do try.monad + [.let [definition (_.set (list @global) input)] + _ (run! definition) + value (run! (_.return @global))] + (in [global value definition])))) + + (def: (ingest context content) + (|> content (\ utf8.codec decoded) try.trusted (:as _.Statement))) + + (def: (re_learn context custom content) + (run! content)) + + (def: (re_load context custom content) + (do try.monad + [_ (run! content)] + (run! (_.return (_.var (reference.artifact context))))))))]))))] + (for {@.old (as_is <jvm>) + @.jvm (as_is <jvm>) + @.lua (as_is (ffi.import: (load [ffi.String] #try ffi.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) + (implementation + (def: (evaluate! context code) + (run! (_.return code))) + + (def: execute! run!) + + (def: (define! context custom input) + (let [global (maybe.else (reference.artifact context) + custom) + @global (_.var global)] + (do try.monad + [.let [definition (_.set (list @global) input)] + _ (run! definition) + value (run! (_.return @global))] + (in [global value definition])))) + + (def: (ingest context content) + (|> content (\ utf8.codec decoded) try.trusted (:as _.Statement))) + + (def: (re_learn context custom content) + (run! content)) + + (def: (re_load context custom content) + (do try.monad + [_ (run! content)] + (run! (_.return (_.var (reference.artifact context))))))))))))})) + +(with_expansions [<jvm> (as_is (exception: .public (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) + (|>> (:as (Array java/lang/Object)) ..lux_structure (:as 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 (:as 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.trusted + (do try.monad + [input/0 (..read input/0)] + (case partial_application + (^ (list partial/0 partial/1)) + (in (..to_host ((:as (-> Any Any Any Any) phase) + partial/0 + partial/1 + input/0))) + + (^ (list partial/0)) + (in (host_phase (list partial/0 input/0) phase)) + + (^ (list)) + (in (host_phase (list input/0) phase)) + + _ + (exception.except ..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.trusted + (do try.monad + [input/0 (..read input/0) + input/1 (..read input/1)] + (case partial_application + (^ (list partial/0)) + (in (..to_host ((:as (-> Any Any Any Any) phase) + partial/0 + input/0 + input/1))) + + (^ (list)) + (in (host_phase (list input/0 input/1) phase)) + + _ + (exception.except ..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.trusted + (do try.monad + [input/0 (..read input/0) + input/1 (..read input/1) + input/2 (..read input/2)] + (case partial_application + (^ (list)) + (in (..to_host ((:as (-> Any Any Any Any) phase) + input/0 + input/1 + input/2))) + + _ + (exception.except ..invaid_phase_application [partial_application 3]))))))) + + (def: (extender [state_context executor] phase_wrapper) + (-> Baggage (-> phase.Wrapper Extender)) + ... TODO: Stop relying on coercions ASAP. + (<| (:as Extender) + (function (@self handler)) + (:as Handler) + (function (@self name phase)) + (:as Phase) + (function (@self archive parameters)) + (:as Operation) + (function (@self state)) + (:as Try) + try.trusted + (:as Try) + (do try.monad + [handler (try.of_maybe (..ensure_function handler)) + output (net/sandius/rembulan/exec/DirectCallExecutor::call state_context + (:as java/lang/Object handler) + (|> (array.empty 5) + (array.write! 0 name) + (array.write! 1 (:as 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.trusted + (:as java/lang/Object) + ..read)))))] + (for {@.old (as_is <jvm>) + @.jvm (as_is <jvm>) + + @.lua + (def: (extender phase_wrapper handler) + (-> phase.Wrapper Extender) + (:expected handler))})) (def: (phase_wrapper archive) - (-> Archive (runtime.Operation platform.Phase_Wrapper)) + (-> Archive (runtime.Operation phase.Wrapper)) (do phase.monad [] - (wrap (:as platform.Phase_Wrapper - (for {@.old (..host_phase (list)) - @.lua (|>>)}))))) - -(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.phase_wrapper ..phase_wrapper - #platform.write (|>> _.code (\ utf8.codec encoded))}]))) - @.lua (def: platform - (IO (Platform [Register _.Label] _.Expression _.Statement)) - (do io.monad - [host ..host] - (wrap {#platform.&file_system (file.async file.default) + (in (:as phase.Wrapper + (for {@.old (..host_phase (list)) + @.jvm (..host_phase (list)) + @.lua (|>>)}))))) + +(with_expansions [<jvm> (def: platform + (IO [Baggage (Platform [Register _.Label] _.Expression _.Statement)]) + (do io.monad + [[baggage host] ..host] + (in [baggage + {#platform.&file_system (file.async file.default) + #platform.host host + #platform.phase lua.generate + #platform.runtime runtime.generate + #platform.phase_wrapper ..phase_wrapper + #platform.write (|>> _.code (\ utf8.codec encoded))}])))] + (for {@.old <jvm> + @.jvm <jvm> + @.lua (def: platform + (IO (Platform [Register _.Label] _.Expression _.Statement)) + (do io.monad + [host ..host] + (in {#platform.&file_system (file.async file.default) #platform.host host #platform.phase lua.generate #platform.runtime runtime.generate #platform.phase_wrapper ..phase_wrapper - #platform.write (|>> _.code (\ utf8.codec encoded))})))}) + #platform.write (|>> _.code (\ utf8.codec encoded))})))})) (def: (program context program) (Program _.Expression _.Statement) @@ -804,6 +815,7 @@ (let [extension ".lua"] (do io.monad [(~~ (for {@.old [baggage platform] + @.jvm [baggage platform] @.lua platform})) ..platform] (exec (do async.monad @@ -812,14 +824,18 @@ #/static.target (/cli.target service) #/static.artifact_extension extension} (for {@.old (..expander baggage) + @.jvm (..expander baggage) @.lua ..expander}) analysis.bundle (io.io platform) generation.bundle (function.constant extension/bundle.empty) ..program - [(& Register _.Label) _.Expression _.Statement] + [(type [Register _.Label]) + _.Expression + _.Statement] (for {@.old (..extender baggage) + @.jvm (..extender baggage) @.lua ..extender}) service [(packager.package (_.manual "") |