diff options
Diffstat (limited to 'lux-lua')
| -rw-r--r-- | lux-lua/commands.md | 4 | ||||
| -rw-r--r-- | lux-lua/source/program.lux | 465 |
2 files changed, 263 insertions, 206 deletions
diff --git a/lux-lua/commands.md b/lux-lua/commands.md index 6ba400775..08fb948a1 100644 --- a/lux-lua/commands.md +++ b/lux-lua/commands.md @@ -11,8 +11,8 @@ cd ~/lux/lux-lua/ && lein clean && lein lux auto test ## Develop ## NOTE: Must set lux/control/concurrency/thread.parallelism = 1 before compiling to make sure Rembulan doesn't cause trouble. cd ~/lux/lux-lua/ \ -&& lein clean \ -&& lein lux auto build +&& lux clean \ +&& lux auto build ``` # Try diff --git a/lux-lua/source/program.lux b/lux-lua/source/program.lux index 2f5fdb67e..f1a759f2d 100644 --- a/lux-lua/source/program.lux +++ b/lux-lua/source/program.lux @@ -3,6 +3,7 @@ [lux "*" [program {"+" program:}] ["[0]" ffi] + ["[0]" static] [abstract ["[0]" monad {"+" do}]] [control @@ -20,9 +21,10 @@ ["[0]" utf8]]] [collection ["[0]" array {"+" Array}] - ["[0]" list]]] + ["[0]" list ("[1]#[0]" monad)]]] [macro - ["[0]" template]] + ["[0]" template] + ["[0]" code]] [math [number {"+" hex} ["n" nat] @@ -33,7 +35,7 @@ ["@" target ["_" lua]] [tool - [compiler + ["[0]" compiler ["[0]" phase {"+" Operation Phase}] [reference [variable {"+" Register}]] @@ -58,12 +60,12 @@ ["[0]" platform {"+" Platform}]] [meta ["[0]" cli] + ["[0]" context] [archive {"+" Archive}] ["[0]" packager "_" ["[1]" script]]]]]]] [program - ["/" compositor - ["[1][0]" static]]]) + ["/" compositor]]) (with_expansions [<jvm> (as_is (ffi.import: java/lang/String) @@ -74,9 +76,11 @@ (toString [] java/lang/String) (getClass [] (java/lang/Class java/lang/Object))]) + (ffi.import: java/lang/Integer) + (ffi.import: java/lang/Long ["[1]::[0]" - (intValue [] java/lang/Integer)]) + (intValue [] int)]) (ffi.import: net/sandius/rembulan/StateContext) @@ -126,6 +130,7 @@ ["[1]::[0]" (getReturnBuffer [] net/sandius/rembulan/runtime/ReturnBuffer)]) + (ffi.import: net/sandius/rembulan/runtime/ResolvedControlThrowable) (ffi.import: net/sandius/rembulan/runtime/LuaFunction) (ffi.import: net/sandius/rembulan/load/ChunkLoader @@ -151,76 +156,15 @@ (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.symbol ["program/" <name>])) - ["[1]::[0]" - (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) + ["Class" (ffi.of_string (java/lang/Object::toString (java/lang/Object::getClass object)))] + ["Object" (ffi.of_string (java/lang/Object::toString object))])) - _ - (panic! (exception.error ..unknown_kind_of_object [(:as java/lang/Object field)]))) + (ffi.interface: LuxValue + (getValue [] java/lang/Object)) - {.#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)]))))) - )))) + (ffi.import: LuxValue + ["[1]::[0]" + (getValue [] java/lang/Object)]) (type: Translator (-> java/lang/Object (Try Any))) @@ -233,7 +177,11 @@ (^multi [{.#Some tag} ?flag {.#Some value}] [(read value) {try.#Success value}]) - {try.#Success [(: Any (|> tag (:as java/lang/Long) java/lang/Long::intValue)) + {try.#Success [(: Any (|> tag + (:as Int) + ffi.as_long + java/lang/Long::intValue + (: java/lang/Integer))) (: Any (case ?flag {.#Some _} (: Any "") {.#None} (:as Any (ffi.null)))) @@ -244,13 +192,13 @@ (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))] + (let [init_num_keys (.nat (ffi.of_long (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) + (case (net/sandius/rembulan/Table::get_idx (ffi.as_long (.int (++ idx))) host_object) {.#None} (again num_keys (++ idx) output) @@ -276,50 +224,237 @@ _)] + [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/runtime/LuaFunction {try.#Success}] [net/sandius/rembulan/ByteString (<| {try.#Success} net/sandius/rembulan/ByteString::decode)] - [program/StructureValue (<| {try.#Success} program/StructureValue::getValue)] + [net/sandius/rembulan/runtime/LuaFunction {try.#Success}] )) (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)) + (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_symbol)))) + + (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 [lux_function abstraction + input/* input/*] + (`` (`` (case input/* + (^ (list)) + (in self) + + (~~ (template [<arity>] + [(^ (list (~~ (static.literals function.identity (..input/* <arity>))))) + (in (to_host ((:as (~~ (static.literal function.identity (..function/* <arity>))) + lux_function) + (~~ (static.literals function.identity (..input/* <arity>))))))] + + [1] + [2] + [3] + [4] + [5] + )) + + (^ (list& (~~ (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)) + + (~~ (template [<arity>] + [(net/sandius/rembulan/runtime/LuaFunction + [] (invoke self [% net/sandius/rembulan/runtime/ExecutionContext + (~~ (static.literals function.identity (..declaration/* <arity>)))]) + void + "throws" [net/sandius/rembulan/runtime/ResolvedControlThrowable] + (<| (..return %) + (apply/* to_host + (ffi.:as net/sandius/rembulan/runtime/LuaFunction self) + (list (~~ (static.literals function.identity (..input/* <arity>)))) + 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.:as net/sandius/rembulan/runtime/LuaFunction self) + (array.list {.#None} input/*) + lux_function))) + ))))) + + (ffi.import: library/lux/Function) + + (def: (lux_structure to_host value) + (-> (-> Any java/lang/Object) (Array java/lang/Object) LuxValue) + (<| (ffi.:as 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.read! (|> idx ffi.of_long .nat --)) + maybe.trusted + to_host)) + + (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 (ffi.of_string (net/sandius/rembulan/ByteString::decode field)) + (^ (static runtime.variant_tag_field)) + (case (array.read! 0 value) + {.#Some it} + (|> it + (:as java/lang/Integer) + (ffi.:as java/lang/Object)) + + {.#None} + (undefined)) + + (^ (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 + to_host) + + "n" + (|> value + array.size + .int + ffi.as_long + (ffi.:as java/lang/Object)) + + _ + (panic! (exception.error ..unknown_kind_of_object [(:as java/lang/Object field)]))) + + {.#None} + (case (ffi.check java/lang/Long field) + {.#Some idx} + (case (array.read! (|> idx ffi.of_long .nat --) value) + {.#Some it} + (to_host it) + + {.#None} + (: java/lang/Object (ffi.null))) + + {.#None} + (panic! (exception.error ..unknown_kind_of_object [(:as java/lang/Object field)]))))) + ))) + (exception: (cannot_apply_a_non_function [object java/lang/Object]) (exception.report - ["Non-function" (java/lang/Object::toString object)])) + ["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.check 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)) + (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 (: (ffi.type [java/lang/Object]) (|> (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)))) + (:as java/lang/Object (lux_structure to_host (: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))))))] + (: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.read! 0) @@ -327,11 +462,11 @@ (:as java/lang/Object) ..read))) - (def: (expander baggage macro inputs lux) - (-> Baggage Expander) + (def: (expander to_host baggage macro inputs lux) + (-> (-> Any java/lang/Object) Baggage Expander) (case (..ensure_function macro) {.#Some macro} - (case (..call_macro baggage inputs lux macro) + (case (..call_macro to_host baggage inputs lux macro) {try.#Success output} (|> output (:as (Try [Lux (List Code)])) @@ -545,13 +680,13 @@ 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") + 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! (: (-> _.Statement (Try Any)) (function (_ code) (do try.monad - [lua_function (net/sandius/rembulan/load/ChunkLoader::loadTextChunk variable "lux compilation" (_.code code) loader) + [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)] (case (array.read! 0 output) @@ -564,23 +699,26 @@ [[state_context executor] (: (Host _.Expression _.Statement) (implementation - (def: (evaluate context code) + (def: (evaluate context [_ code]) (run! (_.return code))) (def: execute run!) - (def: (define context custom input) + (def: (define context custom [_ input]) (let [global (maybe.else (reference.artifact context) custom) - @global (_.var global)] + @global (_.var global) + definition (_.set (list @global) input)] (do try.monad - [.let [definition (_.set (list @global) input)] - _ (run! definition) + [_ (run! definition) value (run! (_.return @global))] (in [global value definition])))) (def: (ingest context content) - (|> content (# utf8.codec decoded) try.trusted (:as _.Statement))) + (|> content + (# utf8.codec decoded) + try.trusted + (:as _.Statement))) (def: (re_learn context custom content) (run! content)) @@ -604,12 +742,12 @@ output)}))))] (: (Host _.Expression _.Statement) (implementation - (def: (evaluate! context code) + (def: (evaluate! context [_ code]) (run! (_.return code))) (def: execute! run!) - (def: (define! context custom input) + (def: (define! context custom [_ input]) (let [global (maybe.else (reference.artifact context) custom) @global (_.var global)] @@ -630,103 +768,20 @@ [_ (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 +(with_expansions [<jvm> (as_is (def: (to_host it) (-> 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)) + (`` (<| (~~ (template [<jvm> <lua>] + [(case (ffi.check <jvm> (:as java/lang/Object it)) + {.#Some it} + (:as java/lang/Object + (<lua> [(:expected it)])) - _ - (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)) + {.#None})] - _ - (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]))))))) + [[java/lang/Object] (..lux_structure to_host)] + [library/lux/Function (..lua_function to_host)] + )) + (:as java/lang/Object it)))) (def: (extender [state_context executor] phase_wrapper) (-> Baggage (-> phase.Wrapper Extender)) @@ -771,8 +826,8 @@ (do phase.monad [] (in (:as phase.Wrapper - (for [@.old (..host_phase (list)) - @.jvm (..host_phase (list)) + (for [@.old (..lua_function ..to_host) + @.jvm (..lua_function ..to_host) @.lua (|>>)]))))) (with_expansions [<jvm> (def: platform @@ -810,6 +865,10 @@ (-> Any (Async Any)) (async.future (# world/program.default exit +0))) +(def: (lux_compiler it) + (-> Any compiler.Custom) + (undefined)) + (`` (program: [service cli.service] (let [extension ".lua"] (do io.monad @@ -818,12 +877,10 @@ @.lua platform])) ..platform] (exec (do async.monad - [_ (/.compiler [/static.#host @.lua - /static.#host_module_extension extension - /static.#target (cli.target service) - /static.#artifact_extension extension] - (for [@.old (..expander baggage) - @.jvm (..expander baggage) + [_ (/.compiler ..lux_compiler + (context.lua (cli.target service)) + (for [@.old (..expander ..to_host baggage) + @.jvm (..expander ..to_host baggage) @.lua ..expander]) analysis.bundle (io.io platform) |