(.require [library [lux (.except) [program (.only program)] ["[0]" ffi] [abstract ["[0]" monad (.only do)]] [control ["[0]" maybe] ["[0]" try (.only Try)] ["[0]" exception (.only Exception)] ["[0]" io (.only IO io)] ["[0]" function] [concurrency ["[0]" async (.only Async)]]] [data ["[0]" text (.use "[1]#[0]" hash) ["%" \\format (.only format)] [encoding ["[0]" utf8]]] [collection ["[0]" array (.only Array)] ["[0]" list (.use "[1]#[0]" monad)]]] [math [number (.only hex) ["n" nat] ["[0]" i64]]] [meta ["[0]" static] ["[0]" code] [macro ["^" pattern] ["[0]" local]] ["@" target (.only) ["_" lua]] ["[0]" compiler ["[0]" phase (.only Operation Phase)] [reference [variable (.only Register)]] [language [lux [program (.only Program)] [generation (.only Host)] [analysis [macro (.only Expander)]] [phase ["[0]" extension (.only Extender Handler) ["[1]/[0]" bundle] ["[0]" analysis ["[1]" lua]] ["[0]" generation ["[1]" lua]]] [generation ["[0]" reference] ["[0]" lua (.only) ["[0]" runtime] ["[1]/[0]" reference]]]]]] [default ["[0]" platform (.only Platform)]] [meta ["[0]" cli] ["[0]" context] [archive (.only Archive)] ["[0]" packager ["[1]" script]]]]] ["[0]" world ["[0]" file] ["[1]/[0]" environment]]]] [program ["/" compositor]]) (with_expansions [ (these (ffi.import java/lang/String "[1]::[0]") (ffi.import (java/lang/Class a) "[1]::[0]") (ffi.import java/lang/Object "[1]::[0]" (toString [] java/lang/String) (getClass [] (java/lang/Class java/lang/Object))) (ffi.import java/lang/Integer "[1]::[0]") (ffi.import java/lang/Long "[1]::[0]" (intValue [] int)) (ffi.import net/sandius/rembulan/StateContext "[1]::[0]") (ffi.import net/sandius/rembulan/impl/StateContexts "[1]::[0]" ("static" newDefaultInstance [] net/sandius/rembulan/StateContext)) (ffi.import net/sandius/rembulan/env/RuntimeEnvironment "[1]::[0]") (ffi.import net/sandius/rembulan/env/RuntimeEnvironments "[1]::[0]" ("static" system [] net/sandius/rembulan/env/RuntimeEnvironment)) (ffi.import net/sandius/rembulan/Table "[1]::[0]" (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 "[1]::[0]" (decode [] java/lang/String)) (ffi.import net/sandius/rembulan/impl/DefaultTable "[1]::[0]") (ffi.import net/sandius/rembulan/impl/ImmutableTable "[1]::[0]") (ffi.import net/sandius/rembulan/impl/ImmutableTable$Builder "[1]::[0]" (new []) (build [] net/sandius/rembulan/impl/ImmutableTable)) (ffi.import net/sandius/rembulan/lib/StandardLibrary "[1]::[0]" ("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 "[1]::[0]" (new [java/lang/Object])) (ffi.import net/sandius/rembulan/runtime/ReturnBuffer "[1]::[0]" (setTo [java/lang/Object] void)) (ffi.import net/sandius/rembulan/runtime/ExecutionContext "[1]::[0]" (getReturnBuffer [] net/sandius/rembulan/runtime/ReturnBuffer)) (ffi.import net/sandius/rembulan/runtime/ResolvedControlThrowable "[1]::[0]") (ffi.import net/sandius/rembulan/runtime/LuaFunction "[1]::[0]") (ffi.import net/sandius/rembulan/load/ChunkLoader "[1]::[0]" (loadTextChunk [net/sandius/rembulan/Variable java/lang/String java/lang/String] "try" net/sandius/rembulan/runtime/LuaFunction)) (ffi.import net/sandius/rembulan/compiler/CompilerChunkLoader "[1]::[0]" ("static" of [java/lang/String] net/sandius/rembulan/compiler/CompilerChunkLoader)) (ffi.import net/sandius/rembulan/runtime/SchedulingContext "[1]::[0]") (ffi.import net/sandius/rembulan/runtime/SchedulingContextFactory "[1]::[0]") (ffi.import net/sandius/rembulan/exec/DirectCallExecutor "[1]::[0]" ("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.def (unknown_kind_of_object object) (Exception java/lang/Object) (exception.report (list ["Class" (ffi.of_string (java/lang/Object::toString (java/lang/Object::getClass object)))] ["Object" (ffi.of_string (java/lang/Object::toString object))]))) (ffi.interface LuxValue (getValue [] java/lang/Object)) (ffi.import LuxValue "[1]::[0]" (getValue [] java/lang/Object)) (type Translator (-> java/lang/Object (Try Any))) (def (read_variant read host_object) (-> Translator net/sandius/rembulan/impl/DefaultTable (Try Any)) (when [(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 [(is Any (|> tag (as Int) ffi.as_long java/lang/Long::intValue (is java/lang/Integer))) (is Any (when ?flag {.#Some _} (is Any "") {.#None} (as Any (ffi.null)))) (is 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 (ffi.of_long (net/sandius/rembulan/Table::rawlen host_object)))] (loop (again [num_keys init_num_keys idx 0 output (is (Array java/lang/Object) (array.empty init_num_keys))]) (if (n.< num_keys idx) (when (net/sandius/rembulan/Table::get_idx (ffi.as_long (.int (++ idx))) host_object) {.#None} (again num_keys (++ idx) output) {.#Some member} (when (read member) {try.#Success parsed_member} (again num_keys (++ idx) (array.has! idx (as java/lang/Object parsed_member) output)) {try.#Failure error} {try.#Failure error})) {try.#Success output})))) (exception.def .public nil_has_no_lux_representation) (def (read host_object) Translator (`` (<| (if (ffi.null? host_object) (exception.except ..nil_has_no_lux_representation [])) (,, (with_template [ ] [(when (ffi.as host_object) {.#Some typed_object} (|> typed_object ) _)] [LuxValue (<| {try.#Success} LuxValue::getValue)] [java/lang/Boolean {try.#Success}] [java/lang/Long {try.#Success}] [java/lang/Double {try.#Success}] [java/lang/String {try.#Success}] [net/sandius/rembulan/ByteString (<| {try.#Success} net/sandius/rembulan/ByteString::decode)] [net/sandius/rembulan/runtime/LuaFunction {try.#Success}] )) (when (ffi.as net/sandius/rembulan/impl/DefaultTable host_object) {.#Some typed_object} (when (read_variant read typed_object) {try.#Failure error} (read_tuple read typed_object) success success) _) (exception.except ..unknown_kind_of_object [host_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 (function/* arity) (-> Nat Code) (` (.-> (,* (list.repeated arity (` .Any))) .Any))) (def input/* (-> Nat (List Code)) (|>> list.indices (list#each (|>> %.nat (format "input/") code.local)))) (def declaration/* (-> Nat (List Code)) (|>> ..input/* (list#each (function (_ $input) (list $input (' java/lang/Object)))) list#conjoint)) (def read/* (-> Nat (List Code)) (|>> ..input/* (list#each (function (_ $input) (list $input (` (..read (, $input)))))) list#conjoint)) (def (apply/* to_host self parameters abstraction) (-> (-> Any java/lang/Object) net/sandius/rembulan/runtime/LuaFunction (List java/lang/Object) Any Any) (<| try.trusted (do [! try.monad] [input/* (monad.each ! ..read parameters)] (loop (again [lux_function abstraction input/* input/*]) (`` (`` (when input/* (list) (in self) (,, (with_template [] [(list (,, (static.literals function.identity (..input/* )))) (in (to_host ((as (,, (static.literal function.identity (..function/* ))) lux_function) (,, (static.literals function.identity (..input/* ))))))] [1] [2] [3] [4] [5] )) (list.partial (,, (static.literals function.identity (..input/* 5))) input/+) (again ((as (,, (static.literal function.identity (..function/* 5))) lux_function) (,, (static.literals function.identity (..input/* 5)))) input/+) ))))))) (def (lua_function to_host lux_function) (-> (-> Any java/lang/Object) Any net/sandius/rembulan/runtime/LuaFunction) (<| (as net/sandius/rembulan/runtime/LuaFunction) (`` (`` (ffi.object [] net/sandius/rembulan/runtime/LuaFunction [LuxValue] [] ... Methods (LuxValue [] (getValue self []) java/lang/Object (as java/lang/Object lux_function)) (net/sandius/rembulan/runtime/LuaFunction [] (invoke self [% net/sandius/rembulan/runtime/ExecutionContext]) void "throws" [net/sandius/rembulan/runtime/ResolvedControlThrowable] (<| (..return %) self)) (,, (with_template [] [(net/sandius/rembulan/runtime/LuaFunction [] (invoke self [% net/sandius/rembulan/runtime/ExecutionContext (,, (static.literals function.identity (..declaration/* )))]) void "throws" [net/sandius/rembulan/runtime/ResolvedControlThrowable] (<| (..return %) (apply/* to_host (ffi.is net/sandius/rembulan/runtime/LuaFunction self) (list (,, (static.literals function.identity (..input/* )))) lux_function)))] [1] [2] [3] [4] [5] )) (net/sandius/rembulan/runtime/LuaFunction [] (invoke self [% net/sandius/rembulan/runtime/ExecutionContext input/* [java/lang/Object]]) void "throws" [net/sandius/rembulan/runtime/ResolvedControlThrowable] (<| (..return %) (apply/* to_host (ffi.is net/sandius/rembulan/runtime/LuaFunction self) (array.list {.#None} input/*) lux_function))) ))))) (ffi.import library/lux/Function "[1]::[0]") (def (lux_structure to_host value) (-> (-> Any java/lang/Object) (Array java/lang/Object) LuxValue) (<| (ffi.is LuxValue) (ffi.object [] net/sandius/rembulan/impl/DefaultTable [LuxValue] [] ... Methods (LuxValue [] (getValue self []) java/lang/Object (as java/lang/Object value)) (net/sandius/rembulan/impl/DefaultTable [] (rawlen self []) long (|> value array.size .int ffi.as_long)) (net/sandius/rembulan/impl/DefaultTable [] (rawget self [idx long]) java/lang/Object (|> value (array.item (|> idx ffi.of_long .nat --)) maybe.trusted to_host)) (net/sandius/rembulan/impl/DefaultTable [] (rawget self [field java/lang/Object]) java/lang/Object (when (ffi.as net/sandius/rembulan/ByteString field) {.#Some field} (when (ffi.of_string (net/sandius/rembulan/ByteString::decode field)) runtime.variant_tag_field (when (array.item 0 value) {.#Some it} (|> it (as java/lang/Integer) (ffi.is java/lang/Object)) {.#None} (undefined)) runtime.variant_flag_field (when (array.item 1 value) {.#Some _} (as java/lang/Object "") {.#None} (ffi.null)) runtime.variant_value_field (|> value (array.item 2) maybe.trusted to_host) "n" (|> value array.size .int ffi.as_long (ffi.is java/lang/Object)) _ (panic! (exception.error ..unknown_kind_of_object [(as java/lang/Object field)]))) {.#None} (when (ffi.as java/lang/Long field) {.#Some idx} (when (array.item (|> idx ffi.of_long .nat --) value) {.#Some it} (to_host it) {.#None} (is java/lang/Object (ffi.null))) {.#None} (panic! (exception.error ..unknown_kind_of_object [(as java/lang/Object field)]))))) ))) (exception.def (cannot_apply_a_non_function object) (Exception java/lang/Object) (exception.report (list ["Non-function" (ffi.of_string (java/lang/Object::toString object))]))) (def ensure_function (-> Macro (Maybe net/sandius/rembulan/runtime/LuaFunction)) (|>> (as java/lang/Object) (ffi.as net/sandius/rembulan/runtime/LuaFunction))) (type Baggage [net/sandius/rembulan/StateContext net/sandius/rembulan/exec/DirectCallExecutor]) (def (call_macro to_host [state_context executor] inputs lux macro) (-> (-> Any java/lang/Object) Baggage (List Code) Lux net/sandius/rembulan/runtime/LuaFunction (Try Any)) (do try.monad [.let [inputs (is (ffi.type [java/lang/Object]) (|> (array.empty 2) (array.has! 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 to_host (as (Array java/lang/Object) inputs)))) (array.has! 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 to_host (as (Array java/lang/Object) lux))))))] output (net/sandius/rembulan/exec/DirectCallExecutor::call state_context (as java/lang/Object macro) inputs executor)] (|> output (array.item 0) maybe.trusted (as java/lang/Object) ..read))) (def (expander to_host baggage macro inputs lux) (-> (-> Any java/lang/Object) Baggage Expander) (when (..ensure_function macro) {.#Some macro} (when (..call_macro to_host 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 (these ) @.jvm (these ) @.lua (def (expander macro inputs lux) Expander {try.#Success ((as Macro' macro) inputs lux)}))) (with_expansions [ (these (with_expansions [$var_args (_.var "...") $str_rel_to_abs (_.var "_utf8_str_rel_to_abs") $decode (_.var "_utf8_decode")] (local.let [!int (template (_ ) [(_.int (.int (hex )))]) !&| (template (_ ) [(|> (_.bit_and (!int )) (_.bit_or (!int )))]) !&|< (template (_ ) [(|> (_.bit_shr (_.int )) (_.bit_and (!int )) (_.bit_or (!int )))])] (these (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 (function (_ in/0 in/1) (_.apply (list in/0 in/1) (_.var "table.insert")))] (_.function (_.var "utf8.char") (list $var_args) (all _.then (_.local/1 $buffer (_.array (list))) (<| (_.for_in (list $k $v) (_.ipairs/1 (_.array (list $var_args)))) (all _.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 (list $buffer (_.string "")) (_.var "table.concat"))) )))) ... (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)) ... (all _.then ... (_.local/1 $args (_.array (list $var_args))) ... (<| (_.for_in (list $k $v) (_.ipairs/1 $args)) ... (all _.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 (list $args) (_.var "table.unpack"))) ... )))) ... (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)) ... (all _.then ... (_.set (list $start) (_.apply (list $string (_.or (_.int +1) $start)) $str_rel_to_abs)) ... (_.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 ... (all _.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) ... (all _.then ... (_.local/1 $i (_.int +1)) ... (_.return (<| (_.closure (list)) ... (_.if (_.> (_.length $string) $i) ... (_.return _.nil) ... (all _.then ... (_.let (list $start $end) (_.apply (list $string $i) $decode)) ... (_.if (_.not $start) ... (_.statement (_.error/2 (_.string "invalid UTF-8 code") (_.int +2))) ... (all _.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) ... (all _.then ... (_.set (list $start $end) (_.apply (list $string (_.or (_.int +1) $start) (_.or (_.int -1) $end)) $str_rel_to_abs)) ... (_.local/1 $size (_.int +0)) ... (_.repeat (_.>= $end $seq_end) ... (all _.then ... (_.let (list $seq_start $seq_end) (_.apply (list $string $start) $decode)) ... (_.if (_.not $seq_start) ... ... Hit an invalid sequence! ... (_.return (_.multi (list (_.boolean false) $start))) ... (all _.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 (all _.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 (ffi.as_string "_lux_definition")) executor (net/sandius/rembulan/exec/DirectCallExecutor::newExecutor) scheduling_context (net/sandius/rembulan/exec/DirectCallExecutor::schedulingContextFactory executor) run! (is (-> _.Statement (Try Any)) (function (_ code) (do try.monad [lua_function (net/sandius/rembulan/load/ChunkLoader::loadTextChunk variable (ffi.as_string "lux compilation") (ffi.as_string (_.code code)) loader) output (net/sandius/rembulan/exec/DirectCallExecutor::call state_context (as java/lang/Object lua_function) (array.empty 0) executor)] (when (array.item 0 output) {.#None} (in []) {.#Some value} (read value))))) _ (try.trusted (run! ..rembulan_prelude))] [[state_context executor] (is (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) definition (_.set (list @global) input)] (do try.monad [_ (run! definition) value (run! (_.return @global))] (in [global value definition])))) (def (ingest context content) (|> content (at 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 (these ) @.jvm (these ) @.lua (these (ffi.import (load [ffi.String] "try" ffi.Function)) (def host (IO (Host _.Expression _.Statement)) (io (let [run! (is (-> _.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)}))))] (is (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 (at 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 [ (these (def (to_host it) (-> Any java/lang/Object) (`` (<| (,, (with_template [ ] [(when (ffi.as (as java/lang/Object it)) {.#Some it} (as java/lang/Object ( [(as_expected it)])) {.#None})] [[java/lang/Object] (..lux_structure to_host)] [library/lux/Function (..lua_function to_host)] )) (as java/lang/Object it)))) (def (extender [state_context executor]) (-> Baggage Extender) ... TODO: Stop relying on coercions ASAP. (<| (as Extender) (function (@self handler)) (as Handler) (function (@self 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.has! 0 name) (array.has! 1 (as java/lang/Object (phase_wrapper phase))) (array.has! 2 (..to_host archive)) (array.has! 3 (..to_host parameters)) (array.has! 4 (..to_host state))) executor)] (|> output (array.item 0) maybe.trusted (as java/lang/Object) ..read)))))] (for @.old (these ) @.jvm (these ) @.lua (def (extender phase_wrapper handler) (-> phase.Wrapper Extender) (as_expected handler)))) (def phase_wrapper phase.Wrapper (for @.old (..lua_function ..to_host) @.jvm (..lua_function ..to_host) @.lua (|>>))) (with_expansions [ (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 (at utf8.codec encoded))]])))] (for @.old @.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 (at utf8.codec encoded))]))))) (def (lux_program context program) (Program _.Expression _.Statement) (let [$program (_.var (reference.artifact context))] (_.statement (_.apply (list (runtime.lux//program_args (_.var "arg")) runtime.unit) program)))) (def (declare_success! _) (-> Any (Async Any)) (async.future (at world/environment.default exit +0))) (def (lux_compiler it) (-> Any platform.Custom) (undefined)) (`` (def _ (program [service cli.service] (let [context (context.lua (cli.target service))] (do io.monad [(,, (for @.old [baggage platform] @.jvm [baggage platform] @.lua platform)) ..platform] (exec (do async.monad [_ (/.compiler ..lux_compiler context (for @.old (..expander ..to_host baggage) @.jvm (..expander ..to_host baggage) @.lua ..expander) analysis.bundle (io.io platform) generation.bundle extension/bundle.empty ..lux_program (reference.constant lua/reference.system) (for @.old (..extender baggage) @.jvm (..extender baggage) @.lua ..extender) service [(packager.package (_.manual "") _.code _.then (|>>)) (format (cli.target service) (at file.default separator) "program" (the context.#artifact_extension context))])] (..declare_success! [])) (io.io [])))))))