diff options
| author | Eduardo Julian | 2021-06-18 14:21:41 -0400 |
|---|---|---|
| committer | Eduardo Julian | 2021-06-18 14:21:41 -0400 |
| commit | a82bd1eabe94763162c2b0707d9c198fbe9835e3 (patch) | |
| tree | 032473704af6e7db41e1f6dc87ab995788d8ab17 /stdlib/source | |
| parent | 519c0c0c71cdf7ce3dfc64b9781ab826760b3d94 (diff) | |
Refactored the machinery to make local macros into its own module.
Diffstat (limited to '')
35 files changed, 778 insertions, 452 deletions
diff --git a/stdlib/source/lux/control/function/mutual.lux b/stdlib/source/lux/control/function/mutual.lux index 705545896..6ccbd2e63 100644 --- a/stdlib/source/lux/control/function/mutual.lux +++ b/stdlib/source/lux/control/function/mutual.lux @@ -17,6 +17,7 @@ [dictionary ["." plist (#+ PList)]]]] ["." macro + ["." local] ["." code] [syntax (#+ syntax:) ["." export] @@ -43,92 +44,6 @@ (function (~ (declaration.format (get@ #declaration mutual))) (~ (get@ #body mutual))))))) -(exception: #export (unknown_module {module Text}) - (exception.report - ["Module" (%.text module)])) - -(template [<name>] - [(exception: #export (<name> {module Text} {definition Text}) - (exception.report - ["Module" (%.text module)] - ["Definition" (%.text definition)]))] - - [cannot_shadow_definition] - [unknown_definition] - ) - -(.def: (with_module name body) - (All [a] (-> Text (-> Module (Try [Module a])) (Meta a))) - (function (_ compiler) - (case (|> compiler (get@ #.modules) (plist.get name)) - (#.Some module) - (case (body module) - (#try.Success [module' output]) - (#try.Success [(update@ #.modules (plist.put name module') compiler) - output]) - - (#try.Failure error) - (#try.Failure error)) - - #.None - (exception.throw ..unknown_module [name])))) - -(.def: (push_one [name macro]) - (-> [Name Macro] (Meta Any)) - (do meta.monad - [[module_name definition_name] (meta.normalize name) - #let [definition (: Global (#.Definition [false .Macro (' {}) macro])) - add_macro! (: (-> (PList Global) (PList Global)) - (plist.put definition_name definition))]] - (..with_module module_name - (function (_ module) - (case (|> module (get@ #.definitions) (plist.get definition_name)) - #.None - (#try.Success [(update@ #.definitions add_macro! module) - []]) - - (#.Some _) - (exception.throw ..cannot_shadow_definition [module_name definition_name])))))) - -(.def: (pop_one name) - (-> Name (Meta Any)) - (do meta.monad - [[module_name definition_name] (meta.normalize name) - #let [remove_macro! (: (-> (PList Global) (PList Global)) - (plist.remove definition_name))]] - (..with_module module_name - (function (_ module) - (case (|> module (get@ #.definitions) (plist.get definition_name)) - (#.Some _) - (#try.Success [(update@ #.definitions remove_macro! module) - []]) - - #.None - (exception.throw ..unknown_definition [module_name definition_name])))))) - -(.def: (pop_all macros self) - (-> (List Name) Name Macro) - (<| (:coerce Macro) - (: Macro') - (function (_ _) - (do {! meta.monad} - [_ (monad.map ! ..pop_one macros) - _ (..pop_one self) - compiler meta.get_compiler] - (wrap (case (get@ #.expected compiler) - (#.Some _) (list (' [])) - #.None (list))))))) - -(.def: (push_all macros) - (-> (List [Name Macro]) (Meta Code)) - (do meta.monad - [_ (monad.map meta.monad ..push_one macros) - seed meta.count - g!pop (macro.gensym "pop") - _ (.let [g!pop (: Name ["" (%.code g!pop)])] - (..push_one [g!pop (..pop_all (list\map product.left macros) g!pop)]))] - (wrap (` ((~ g!pop)))))) - (.def: (macro g!context g!self) (-> Code Code Macro) (<| (:coerce Macro) @@ -163,7 +78,7 @@ functions) user_names (list\map (|>> (get@ [#declaration #declaration.name]) code.local_identifier) functions)] - g!pop (..push_all (list\map (function (_ [g!name mutual]) + g!pop (local.push (list\map (function (_ [g!name mutual]) [[here_name (get@ [#declaration #declaration.name] mutual)] (..macro g!context g!name)]) (list.zip/2 hidden_names @@ -216,7 +131,7 @@ functions) user_names (list\map (|>> (get@ [#mutual #declaration #declaration.name]) code.local_identifier) functions)] - g!pop (..push_all (list\map (function (_ [g!name mutual]) + g!pop (local.push (list\map (function (_ [g!name mutual]) [[here_name (get@ [#mutual #declaration #declaration.name] mutual)] (..macro g!context g!name)]) (list.zip/2 hidden_names diff --git a/stdlib/source/lux/ffi.jvm.lux b/stdlib/source/lux/ffi.jvm.lux index ad087f95b..4e684acf5 100644 --- a/stdlib/source/lux/ffi.jvm.lux +++ b/stdlib/source/lux/ffi.jvm.lux @@ -1530,12 +1530,14 @@ (def: (jvm_invoke_inputs mode classes inputs) (-> Primitive_Mode (List (Type Value)) (List [Bit Code]) (List Code)) (|> inputs - (list\map (function (_ [maybe? input]) - (if maybe? - (` ((~! !!!) (~ (un_quote input)))) - (un_quote input)))) (list.zip/2 classes) - (list\map (auto_convert_input mode)))) + (list\map (function (_ [class [maybe? input]]) + (|> (if maybe? + (` (: (.primitive (~ (code.text (..reflection class)))) + ((~! !!!) (~ (un_quote input))))) + (un_quote input)) + [class] + (auto_convert_input mode)))))) (def: (import_name format class member) (-> Text Text Text Text) diff --git a/stdlib/source/lux/ffi.old.lux b/stdlib/source/lux/ffi.old.lux index 346fa4dc8..a867cd811 100644 --- a/stdlib/source/lux/ffi.old.lux +++ b/stdlib/source/lux/ffi.old.lux @@ -1417,8 +1417,8 @@ _ (\ meta.monad wrap [(list) (list) (list)]))) -(def: (decorate_return_maybe member return_term) - (-> Import_Member_Declaration Code Code) +(def: (decorate_return_maybe class member return_term) + (-> Class_Declaration Import_Member_Declaration Code Code) (case member (^or (#ConstructorDecl [commons _]) (#MethodDecl [commons _])) (if (get@ #import_member_maybe? commons) @@ -1428,7 +1428,9 @@ (if (not (..null? (:coerce (primitive "java.lang.Object") (~ g!temp)))) (~ g!temp) - (error! "Cannot produce null references from method calls.")))))) + (error! (~ (code.text (format "Cannot produce null references from method calls @ " + (get@ #class_name class) + "." (get@ #import_member_alias commons)))))))))) _ return_term)) @@ -1532,7 +1534,7 @@ jvm_extension (code.text (format "jvm new" ":" full_name ":" (text.join_with "," arg_classes))) jvm_interop (|> (` ((~ jvm_extension) (~+ (jvm_extension_inputs (get@ #import_member_mode commons) arg_classes arg_function_inputs)))) - (decorate_return_maybe member) + (decorate_return_maybe class member) (decorate_return_try member) (decorate_return_io member))]] (wrap (list (` ((~! syntax:) ((~ def_name) (~+ (list\map product.right arg_function_inputs))) @@ -1565,7 +1567,7 @@ (` ((~ jvm_extension) (~+ (list\map un_quote object_ast)) (~+ (jvm_extension_inputs (get@ #import_member_mode commons) arg_classes arg_function_inputs))))] (auto_convert_output (get@ #import_member_mode commons)) - (decorate_return_maybe member) + (decorate_return_maybe class member) (decorate_return_try member) (decorate_return_io member))]] (wrap (list (` ((~! syntax:) ((~ def_name) (~+ (list\map product.right arg_function_inputs)) (~+ object_ast)) diff --git a/stdlib/source/lux/macro.lux b/stdlib/source/lux/macro.lux index 21caf5bae..e5a9ff9ef 100644 --- a/stdlib/source/lux/macro.lux +++ b/stdlib/source/lux/macro.lux @@ -86,6 +86,21 @@ [members' (monad.map //.monad expand_all members)] (wrap (list (code.tuple (list\join members'))))) + [_ (#.Record members)] + (|> members + (monad.map //.monad + (function (_ [left right]) + (do //.monad + [left (expand_all left) + right (expand_all right)] + (case [left right] + [(#.Cons left #.Nil) (#.Cons right #.Nil)] + (wrap [left right]) + + _ + (//.fail "Record members must expand into singletons."))))) + (\ //.monad map (|>> code.record list))) + _ (\ //.monad wrap (list syntax)))) diff --git a/stdlib/source/lux/macro/local.lux b/stdlib/source/lux/macro/local.lux new file mode 100644 index 000000000..fc9e8bef5 --- /dev/null +++ b/stdlib/source/lux/macro/local.lux @@ -0,0 +1,105 @@ +(.module: + [lux #* + ["." meta] + [abstract + ["." monad (#+ do)]] + [control + ["." try (#+ Try)] + ["." exception (#+ exception:)]] + [data + ["." product] + ["." text] + [collection + ["." list ("#\." functor)] + [dictionary + ["." plist (#+ PList)]]]]] + ["." // + ["#." code]]) + +(exception: #export (unknown_module {module Text}) + (exception.report + ["Module" (text.format module)])) + +(template [<name>] + [(exception: #export (<name> {module Text} {definition Text}) + (exception.report + ["Module" (text.format module)] + ["Definition" (text.format definition)]))] + + [cannot_shadow_definition] + [unknown_definition] + ) + +(def: (with_module name body) + (All [a] (-> Text (-> Module (Try [Module a])) (Meta a))) + (function (_ compiler) + (case (|> compiler (get@ #.modules) (plist.get name)) + (#.Some module) + (case (body module) + (#try.Success [module' output]) + (#try.Success [(update@ #.modules (plist.put name module') compiler) + output]) + + (#try.Failure error) + (#try.Failure error)) + + #.None + (exception.throw ..unknown_module [name])))) + +(def: (push_one [name macro]) + (-> [Name Macro] (Meta Any)) + (do meta.monad + [[module_name definition_name] (meta.normalize name) + #let [definition (: Global (#.Definition [false .Macro (' {}) macro])) + add_macro! (: (-> (PList Global) (PList Global)) + (plist.put definition_name definition))]] + (..with_module module_name + (function (_ module) + (case (|> module (get@ #.definitions) (plist.get definition_name)) + #.None + (#try.Success [(update@ #.definitions add_macro! module) + []]) + + (#.Some _) + (exception.throw ..cannot_shadow_definition [module_name definition_name])))))) + +(def: (pop_one name) + (-> Name (Meta Any)) + (do meta.monad + [[module_name definition_name] (meta.normalize name) + #let [remove_macro! (: (-> (PList Global) (PList Global)) + (plist.remove definition_name))]] + (..with_module module_name + (function (_ module) + (case (|> module (get@ #.definitions) (plist.get definition_name)) + (#.Some _) + (#try.Success [(update@ #.definitions remove_macro! module) + []]) + + #.None + (exception.throw ..unknown_definition [module_name definition_name])))))) + +(def: (pop_all macros self) + (-> (List Name) Name Macro) + ("lux macro" + (function (_ _) + (do {! meta.monad} + [_ (monad.map ! ..pop_one macros) + _ (..pop_one self) + compiler meta.get_compiler] + (wrap (case (get@ #.expected compiler) + (#.Some _) + (list (' [])) + + #.None + (list))))))) + +(def: #export (push macros) + (-> (List [Name Macro]) (Meta Code)) + (do meta.monad + [_ (monad.map meta.monad ..push_one macros) + seed meta.count + g!pop (//.gensym "pop") + _ (let [g!pop (: Name ["" (//code.format g!pop)])] + (..push_one [g!pop (..pop_all (list\map product.left macros) g!pop)]))] + (wrap (` ((~ g!pop)))))) diff --git a/stdlib/source/lux/macro/template.lux b/stdlib/source/lux/macro/template.lux index d51af1d5c..6271b7cd4 100644 --- a/stdlib/source/lux/macro/template.lux +++ b/stdlib/source/lux/macro/template.lux @@ -12,9 +12,8 @@ ["." bit ("#\." codec)] ["." text] [collection - ["." list ("#\." monad fold)] - ["." dictionary (#+ Dictionary) - ["." plist]]]] + ["." list ("#\." monad)] + ["." dictionary (#+ Dictionary)]]] [math [number ["." nat ("#\." decimal)] @@ -23,7 +22,8 @@ ["." frac ("#\." decimal)]]]] ["." // [syntax (#+ syntax:)] - ["." code]]) + ["." code] + ["." local]]) (syntax: #export (splice {parts (<code>.tuple (<>.some <code>.any))}) (wrap parts)) @@ -106,7 +106,7 @@ (case (dictionary.get name env) (#.Some substitute) substitute - + #.None template) @@ -137,16 +137,17 @@ ["Actual" (\ nat.decimal encode actual)])) (def: (macro (^slots [#parameters #template])) - (-> Local Macro') - (function (_ inputs compiler) - (let [parameters_count (list.size parameters) - inputs_count (list.size inputs)] - (if (nat.= parameters_count inputs_count) - (let [environment (: Environment - (|> (list.zip/2 parameters inputs) - (dictionary.from_list text.hash)))] - (#.Right [compiler (list\map (..apply environment) template)])) - (exception.throw ..irregular_arguments [parameters_count inputs_count]))))) + (-> Local Macro) + ("lux macro" + (function (_ inputs compiler) + (let [parameters_count (list.size parameters) + inputs_count (list.size inputs)] + (if (nat.= parameters_count inputs_count) + (let [environment (: Environment + (|> (list.zip/2 parameters inputs) + (dictionary.from_list text.hash)))] + (#.Right [compiler (list\map (..apply environment) template)])) + (exception.throw ..irregular_arguments [parameters_count inputs_count])))))) (def: local (Parser Local) @@ -158,61 +159,26 @@ #parameters parameters #template template}))) -(exception: #export (cannot_shadow_definition {module Text} {definition Text}) - (exception.report - ["Module" (text.format module)] - ["Definition" (text.format definition)])) - -(def: (push module_name local module) - (-> Text Local Module (Try Module)) - (let [definition (get@ #name local)] - (case (plist.get definition (get@ #.definitions module)) - #.None - (#try.Success (update@ #.definitions - (plist.put definition - (#.Definition [false .Macro (' {}) (..macro local)])) - module)) - - (#.Some _) - (exception.throw ..cannot_shadow_definition [module_name definition])))) - -(syntax: (pop {locals (<>.some <code>.text)}) - (do meta.monad - [here_name meta.current_module_name - here meta.current_module] - (function (_ compiler) - (#.Right [(let [definitions (list\fold plist.remove - (get@ #.definitions here) - locals)] - (update@ #.modules - (plist.put here_name (set@ #.definitions definitions here)) - compiler)) - (case (get@ #.expected compiler) - #.None - (list) - - (#.Some _) - (list (' [])))])))) - (syntax: #export (with {locals (<code>.tuple (<>.some ..local))} body) (do meta.monad [here_name meta.current_module_name - here meta.current_module] - (//.with_gensyms [g!body] - (function (_ compiler) - (do try.monad - [here (monad.fold try.monad (..push here_name) here locals) - #let [compiler (update@ #.modules (plist.put here_name here) compiler) - pop! (` ((~! ..pop) (~+ (list\map (|>> (get@ #name) code.text) - locals))))]] - (wrap [compiler - (case (get@ #.expected compiler) - #.None - (list body - pop!) - - (#.Some _) - (list (` (let [(~ g!body) (~ body)] - (exec (~ pop!) - (~ g!body))))))])))))) + expression? (: (Meta Bit) + (function (_ lux) + (#try.Success [lux (case (get@ #.expected lux) + #.None + false + + (#.Some _) + true)]))) + g!pop (local.push (list\map (function (_ local) + [[here_name (get@ #name local)] + (..macro local)]) + locals))] + (if expression? + (//.with_gensyms [g!body] + (wrap (list (` (let [(~ g!body) (~ body)] + (exec (~ g!pop) + (~ g!body))))))) + (wrap (list body + g!pop))))) diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux index 4cf486c43..513765864 100644 --- a/stdlib/source/lux/test.lux +++ b/stdlib/source/lux/test.lux @@ -155,7 +155,7 @@ (exception: #export must_try_test_at_least_once) ## TODO: Figure out why tests sometimes freeze and fix it. Delete "times'" afterwards. -(def: (times' millis_time_out amount test) +(def: #export (times' millis_time_out amount test) (-> (Maybe Nat) Nat Test Test) (case amount 0 (..fail (exception.construct ..must_try_test_at_least_once [])) diff --git a/stdlib/source/lux/tool/compiler/default/init.lux b/stdlib/source/lux/tool/compiler/default/init.lux index 781383df8..e697f62a9 100644 --- a/stdlib/source/lux/tool/compiler/default/init.lux +++ b/stdlib/source/lux/tool/compiler/default/init.lux @@ -1,6 +1,6 @@ (.module: [lux (#- Module) - ["@" target (#+ Host)] + ["@" target (#+ Target)] [abstract ["." monad (#+ do)]] [control @@ -51,7 +51,7 @@ (def: #export (state target module expander host_analysis host generate generation_bundle host_directive_bundle program anchorT,expressionT,directiveT extender) (All [anchor expression directive] - (-> Host + (-> Target Module Expander ///analysis.Bundle diff --git a/stdlib/source/lux/tool/compiler/default/platform.lux b/stdlib/source/lux/tool/compiler/default/platform.lux index a89ddd43e..d505f5f7c 100644 --- a/stdlib/source/lux/tool/compiler/default/platform.lux +++ b/stdlib/source/lux/tool/compiler/default/platform.lux @@ -2,7 +2,7 @@ [lux (#- Module) [type (#+ :share)] ["." debug] - ["@" target (#+ Host)] + ["@" target] [abstract ["." monad (#+ Monad do)]] [control diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux index 4203516d4..bb5587dfe 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux @@ -934,7 +934,7 @@ (wrap []) (do ! [from_class (phase.lift (reflection!.load from_name))] - (phase.assert cannot_cast [fromT toT fromC] + (phase.assert ..cannot_cast [fromT toT fromC] (java/lang/Class::isAssignableFrom from_class to_class))))] (loop [[current_name currentT] [from_name fromT]] (if (text\= to_name current_name) diff --git a/stdlib/source/lux/tool/compiler/meta/io/archive.lux b/stdlib/source/lux/tool/compiler/meta/io/archive.lux index 8cf7fdcc2..7fe4b96a9 100644 --- a/stdlib/source/lux/tool/compiler/meta/io/archive.lux +++ b/stdlib/source/lux/tool/compiler/meta/io/archive.lux @@ -1,6 +1,6 @@ (.module: [lux (#- Module) - ["@" target (#+ Host)] + ["@" target (#+ Target)] [abstract [predicate (#+ Predicate)] ["." monad (#+ do)]] @@ -171,11 +171,11 @@ (document.parser $.parser))) (def: (fresh_analysis_state host) - (-> Host .Lux) + (-> Target .Lux) (analysis.state (analysis.info version.version host))) (def: (analysis_state host archive) - (-> Host Archive (Try .Lux)) + (-> Target Archive (Try .Lux)) (do {! try.monad} [modules (: (Try (List [Module .Module])) (monad.map ! (function (_ module) diff --git a/stdlib/source/lux/world/input/keyboard.lux b/stdlib/source/lux/world/input/keyboard.lux index ccb90d30c..90068c197 100644 --- a/stdlib/source/lux/world/input/keyboard.lux +++ b/stdlib/source/lux/world/input/keyboard.lux @@ -7,16 +7,16 @@ (template [<code> <name>] [(def: #export <name> Key <code>)] - [00008 back-space] + [00008 back_space] [00010 enter] [00016 shift] [00017 control] [00018 alt] - [00020 caps-lock] + [00020 caps_lock] [00027 escape] [00032 space] - [00033 page-up] - [00034 page-down] + [00033 page_up] + [00034 page_down] [00035 end] [00036 home] @@ -52,21 +52,21 @@ [00089 y] [00090 z] - [00096 num-pad-0] - [00097 num-pad-1] - [00098 num-pad-2] - [00099 num-pad-3] - [00100 num-pad-4] - [00101 num-pad-5] - [00102 num-pad-6] - [00103 num-pad-7] - [00104 num-pad-8] - [00105 num-pad-9] + [00096 num_pad_0] + [00097 num_pad_1] + [00098 num_pad_2] + [00099 num_pad_3] + [00100 num_pad_4] + [00101 num_pad_5] + [00102 num_pad_6] + [00103 num_pad_7] + [00104 num_pad_8] + [00105 num_pad_9] [00127 delete] - [00144 num-lock] - [00145 scroll-lock] - [00154 print-screen] + [00144 num_lock] + [00145 scroll_lock] + [00154 print_screen] [00155 insert] [00524 windows] @@ -99,3 +99,13 @@ (type: #export Press {#pressed? Bit #input Key}) + +(template [<bit> <name>] + [(def: #export (<name> key) + (-> Key Press) + {#pressed? <bit> + #input key})] + + [#0 release] + [#1 press] + ) diff --git a/stdlib/source/lux/world/shell.lux b/stdlib/source/lux/world/shell.lux index dd6bc529d..77da2c9d8 100644 --- a/stdlib/source/lux/world/shell.lux +++ b/stdlib/source/lux/world/shell.lux @@ -7,6 +7,7 @@ [control ["." function] ["." try (#+ Try)] + ["." exception (#+ exception:)] ["." io (#+ IO)] [security ["!" capability (#+ capability:)] @@ -108,6 +109,7 @@ [process (!.use (\ shell execute) input)] (wrap (..async_process process))))))))) +## https://en.wikipedia.org/wiki/Code_injection#Shell_injection (signature: (Policy ?) (: (-> Command (Safe Command ?)) command) @@ -220,7 +222,7 @@ (import: java/io/BufferedReader ["#::." (new [java/io/Reader]) - (readLine [] #io #try java/lang/String)]) + (readLine [] #io #try #? java/lang/String)]) (import: java/io/InputStream) @@ -240,9 +242,11 @@ (destroy [] #io #try void) (waitFor [] #io #try int)]) + (exception: #export no_more_output) + (def: (default_process process) (-> java/lang/Process (IO (Try (Process IO)))) - (do (try.with io.monad) + (do {! (try.with io.monad)} [jvm_input (java/lang/Process::getInputStream process) jvm_error (java/lang/Process::getErrorStream process) jvm_output (java/lang/Process::getOutputStream process) @@ -258,7 +262,14 @@ [(def: <name> (..can_read (function (_ _) - (java/io/BufferedReader::readLine <stream>))))] + (do ! + [output (java/io/BufferedReader::readLine <stream>)] + (case output + (#.Some output) + (wrap output) + + #.None + (\ io.monad wrap (exception.throw ..no_more_output [])))))))] [read jvm_input] [error jvm_error] @@ -300,39 +311,23 @@ (|>> java/lang/String::toLowerCase (text.starts_with? "windows")) (java/lang/System::getProperty "os.name"))) - (def: (jvm::process_builder policy command arguments) - (All [?] - (-> (Policy ?) (Safe Command ?) (List (Safe Argument ?)) - java/lang/ProcessBuilder)) - (|> (list\map (\ policy value) arguments) - (list& (\ policy value command)) - ..jvm::arguments_array - java/lang/ProcessBuilder::new)) - (structure: #export default (Shell IO) (def: execute (..can_execute (function (_ [environment working_directory command arguments]) - (with_expansions [<jvm> (as_is (do {! (try.with io.monad)} - [windows? ..windows? - #let [builder (if windows? - (..jvm::process_builder ..windows_policy - (\ ..windows_policy command command) - (list\map (\ ..windows_policy argument) arguments)) - (..jvm::process_builder ..unix_policy - (\ ..unix_policy command command) - (list\map (\ ..unix_policy argument) arguments)))] - _ (|> builder - (java/lang/ProcessBuilder::directory (java/io/File::new working_directory)) - java/lang/ProcessBuilder::environment - (\ try.functor map (..jvm::load_environment environment)) - (\ io.monad wrap)) - process (java/lang/ProcessBuilder::start builder)] - (..default_process process)))] - (for {@.old (as_is <jvm>) - @.jvm (as_is <jvm>)})))))) + (do {! (try.with io.monad)} + [#let [builder (|> (list& command arguments) + ..jvm::arguments_array + java/lang/ProcessBuilder::new + (java/lang/ProcessBuilder::directory (java/io/File::new working_directory)))] + _ (|> builder + java/lang/ProcessBuilder::environment + (\ try.functor map (..jvm::load_environment environment)) + (\ io.monad wrap)) + process (java/lang/ProcessBuilder::start builder)] + (..default_process process)))))) )] (for {@.old (as_is <jvm>) @.jvm (as_is <jvm>)} diff --git a/stdlib/source/program/aedifex/command/build.lux b/stdlib/source/program/aedifex/command/build.lux index 388a48c89..7052109fb 100644 --- a/stdlib/source/program/aedifex/command/build.lux +++ b/stdlib/source/program/aedifex/command/build.lux @@ -25,7 +25,7 @@ [world [program (#+ Program)] ["." file (#+ Path)] - ["." shell (#+ Shell)] + ["." shell (#+ Process Shell)] ["." console (#+ Console)] [net ["." uri]]]] @@ -79,8 +79,8 @@ (exception: #export no_specified_target) (type: #export Compiler - (#JVM Artifact) - (#JS Artifact)) + (#JVM Dependency) + (#JS Dependency)) (def: (remove_dependency dependency) (-> Dependency (-> Resolution Resolution)) @@ -94,28 +94,30 @@ (..js_compiler resolution)] [(#.Some dependency) _] (#try.Success [(..remove_dependency dependency resolution) - (#JVM (get@ #///dependency.artifact dependency))]) + (#JVM dependency)]) [_ (#.Some dependency)] (#try.Success [(..remove_dependency dependency resolution) - (#JS (get@ #///dependency.artifact dependency))]) + (#JS dependency)]) _ (exception.throw ..no_available_compiler []))) -(def: (path fs home artifact) - (All [!] (-> (file.System !) Path Artifact Path)) - (let [/ (\ fs separator)] +(def: (path fs home dependency) + (All [!] (-> (file.System !) Path Dependency Path)) + (let [/ (\ fs separator) + artifact (get@ #///dependency.artifact dependency)] (|> artifact (///local.uri (get@ #///artifact.version artifact)) (text.replace_all uri.separator /) - (format home /)))) + (format home /) + (text.suffix (format "." (get@ #///dependency.type dependency)))))) (def: (libraries fs home) (All [!] (-> (file.System !) Path Resolution (List Path))) (|>> dictionary.keys (list.filter (|>> (get@ #///dependency.type) (text\= ///artifact/type.lux_library))) - (list\map (|>> (get@ #///dependency.artifact) (..path fs home))))) + (list\map (..path fs home)))) (def: (singular name) (-> Text Text (List Text)) @@ -129,6 +131,26 @@ (def: #export success "[BUILD ENDED]") (def: #export failure "[BUILD FAILED]") +(template [<name> <capability>] + [(def: (<name> console process) + (-> (Console Promise) (Process Promise) (Promise (Try Any))) + (do {! promise.monad} + [?line (!.use (\ process <capability>) [])] + (case ?line + (#try.Failure error) + (if (exception.match? shell.no_more_output error) + (wrap (#try.Success [])) + (console.write_line error console)) + + (#try.Success line) + (do (try.with !) + [_ (console.write_line line console)] + (log_output! console process)))))] + + [log_output! read] + [log_error! error] + ) + (def: #export (do! console program fs shell resolution profile) (-> (Console Promise) (Program Promise) (file.System Promise) (Shell Promise) Resolution (Command [Compiler Path])) (case [(get@ #///.program profile) @@ -146,12 +168,11 @@ working_directory (\ program directory [])] (do ///action.monad [[resolution compiler] (promise\wrap (..compiler resolution)) - #let [[command output] (let [[compiler output] (case compiler - (#JVM artifact) [(///runtime.java (..path fs home artifact)) - "program.jar"] - (#JS artifact) [(///runtime.node (..path fs home artifact)) - "program.js"])] - [(format compiler " build") output]) + #let [[[command compiler_params] output] (case compiler + (#JVM dependency) [(///runtime.java (..path fs home dependency)) + "program.jar"] + (#JS dependency) [(///runtime.node (..path fs home dependency)) + "program.js"]) / (\ fs separator) cache_directory (format working_directory / target)] _ (console.write_line ..start console) @@ -159,10 +180,14 @@ [environment working_directory command - (list.concat (list (..plural "--library" (..libraries fs home resolution)) + (list.concat (list compiler_params + (list "build") + (..plural "--library" (..libraries fs home resolution)) (..plural "--source" (set.to_list (get@ #///.sources profile))) (..singular "--target" cache_directory) (..singular "--module" program_module)))]) + _ (..log_output! console process) + _ (..log_error! console process) exit (!.use (\ process await) []) _ (console.write_line (if (i.= shell.normal exit) ..success diff --git a/stdlib/source/program/aedifex/command/deps.lux b/stdlib/source/program/aedifex/command/deps.lux index 14b5d803f..d699de528 100644 --- a/stdlib/source/program/aedifex/command/deps.lux +++ b/stdlib/source/program/aedifex/command/deps.lux @@ -12,7 +12,7 @@ ["." list ("#\." fold)] ["." dictionary]] [text - ["%" format (#+ format)]]] + ["%" format]]] [world [program (#+ Program)] ["." file] @@ -29,7 +29,7 @@ ["#/." resolution (#+ Resolution)] ["#/." deployment]]]]) -(def: %dependency +(def: format (%.Format Dependency) (|>> (get@ #///dependency.artifact) ///artifact.format @@ -47,13 +47,13 @@ (///dependency/deployment.all local)) _ (console.write_line //clean.success console) _ (console.write_line (exception.report - ["Local successes" (exception.enumerate %dependency local_successes)] - ["Local failures" (exception.enumerate %dependency local_failures)] + ["Local successes" (exception.enumerate ..format local_successes)] + ["Local failures" (exception.enumerate ..format local_failures)] ["Remote successes" (let [remote_successes (|> remote_successes (set.from_list ///dependency.hash) (set.difference (set.from_list ///dependency.hash local_successes)) set.to_list)] - (exception.enumerate %dependency remote_successes))] - ["Remote failures" (exception.enumerate %dependency remote_failures)]) + (exception.enumerate ..format remote_successes))] + ["Remote failures" (exception.enumerate ..format remote_failures)]) console)] (wrap resolution)))) diff --git a/stdlib/source/program/aedifex/command/test.lux b/stdlib/source/program/aedifex/command/test.lux index dff9b14ee..c3b517437 100644 --- a/stdlib/source/program/aedifex/command/test.lux +++ b/stdlib/source/program/aedifex/command/test.lux @@ -39,13 +39,14 @@ (do ///action.monad [[compiler program] (//build.do! console program fs shell resolution profile) _ (console.write_line ..start console) + #let [[compiler_command compiler_parameters] (case compiler + (#//build.JVM artifact) (///runtime.java program) + (#//build.JS artifact) (///runtime.node program))] process (!.use (\ shell execute) [environment working_directory - (case compiler - (#//build.JVM artifact) (///runtime.java program) - (#//build.JS artifact) (///runtime.node program)) - (list)]) + compiler_command + compiler_parameters]) exit (!.use (\ process await) []) _ (console.write_line (if (i.= shell.normal exit) ..success diff --git a/stdlib/source/program/aedifex/dependency/resolution.lux b/stdlib/source/program/aedifex/dependency/resolution.lux index 89ad6368f..2d92e1438 100644 --- a/stdlib/source/program/aedifex/dependency/resolution.lux +++ b/stdlib/source/program/aedifex/dependency/resolution.lux @@ -196,7 +196,7 @@ failures tail resolution) - _ (do promise.monad + _ (do {! promise.monad} [?package (case (dictionary.get head resolution) (#.Some package) (wrap (#try.Success package)) @@ -205,23 +205,32 @@ (..any repositories head))] (case ?package (#try.Success package) - (let [sub_dependencies (|> package - ///package.dependencies - (try\map set.to_list) - (try.default (list))) - sub_repositories (|> package - ///package.repositories - (try\map set.to_list) - (try.default (list)) - (list\map (|>> (///repository/remote.repository #.None) - ///repository.async)) - (list\compose repositories))] - (|> resolution - (dictionary.put head package) - (recur sub_repositories - (#.Cons head successes) - failures - sub_dependencies))) + (do ! + [#let [sub_dependencies (|> package + ///package.dependencies + (try\map set.to_list) + (try.default (list))) + sub_repositories (|> package + ///package.repositories + (try\map set.to_list) + (try.default (list)) + (list\map (|>> (///repository/remote.repository #.None) + ///repository.async)) + (list\compose repositories))] + [successes failures resolution] (recur sub_repositories + (#.Cons head successes) + failures + sub_dependencies + (dictionary.put head package resolution))] + (recur repositories + successes + failures + tail + resolution)) (#try.Failure error) - (wrap [successes (#.Cons head failures) resolution]))))))) + (recur repositories + successes + (#.Cons head failures) + tail + resolution))))))) diff --git a/stdlib/source/program/aedifex/parser.lux b/stdlib/source/program/aedifex/parser.lux index 411b4665b..046c8893c 100644 --- a/stdlib/source/program/aedifex/parser.lux +++ b/stdlib/source/program/aedifex/parser.lux @@ -215,7 +215,7 @@ ^deploy_repositories (: (Parser (Dictionary Text //repository.Address)) (<| (\ ! map (dictionary.from_list text.hash)) (<>.default (list)) - (..singular input "deploy-repositories" ..deploy_repository)))]] + (..singular input "deploy_repositories" ..deploy_repository)))]] ($_ <>.and ^parents ^identity diff --git a/stdlib/source/program/aedifex/runtime.lux b/stdlib/source/program/aedifex/runtime.lux index 6abfc5a62..42b1c315a 100644 --- a/stdlib/source/program/aedifex/runtime.lux +++ b/stdlib/source/program/aedifex/runtime.lux @@ -3,15 +3,17 @@ [data [text ["%" format (#+ format)]]] + [macro + ["." template]] [world [file (#+ Path)] [shell (#+ Command)]]]) -(template [<name> <command>] - [(def: #export <name> - (-> Path Command) - (|>> (format <command>)))] +(template [<name> <command> <parameters>] + [(def: #export (<name> path) + (-> Path [Text (List Text)]) + (`` (format [<command> (list (~~ (template.splice <parameters>)) path)])))] - [java "java -jar "] - [node "node --stack_size=8192 "] + [java "java" ["-jar"]] + [node "node" ["--stack_size=8192"]] ) diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux index 03e9b281d..a6b85ccf0 100644 --- a/stdlib/source/program/compositor.lux +++ b/stdlib/source/program/compositor.lux @@ -2,7 +2,7 @@ [lux (#- Module) [type (#+ :share)] ["." debug] - ["@" target (#+ Host)] + ["@" target] [abstract [monad (#+ Monad do)]] [control diff --git a/stdlib/source/program/compositor/static.lux b/stdlib/source/program/compositor/static.lux index 51bbef0e9..d5e100f30 100644 --- a/stdlib/source/program/compositor/static.lux +++ b/stdlib/source/program/compositor/static.lux @@ -1,11 +1,11 @@ (.module: [lux #* - [target (#+ Host)] + [target (#+ Target)] [world [file (#+ Path)]]]) (type: #export Static - {#host Host + {#host Target #host_module_extension Text #target Path #artifact_extension Text}) diff --git a/stdlib/source/spec/aedifex/repository.lux b/stdlib/source/spec/aedifex/repository.lux index 250bd3d01..1688f1e03 100644 --- a/stdlib/source/spec/aedifex/repository.lux +++ b/stdlib/source/spec/aedifex/repository.lux @@ -29,11 +29,11 @@ [expected (_binary.random 100)] (wrap ($_ _.and' (do promise.monad - [#let [uri/good (/remote.uri valid_artifact //artifact/extension.lux_library)] + [#let [uri/good (/remote.uri (get@ #//artifact.version valid_artifact) valid_artifact //artifact/extension.lux_library)] upload!/good (\ subject upload uri/good expected) download!/good (\ subject download uri/good) - #let [uri/bad (/remote.uri invalid_artifact //artifact/extension.lux_library)] + #let [uri/bad (/remote.uri (get@ #//artifact.version invalid_artifact) invalid_artifact //artifact/extension.lux_library)] upload!/bad (\ subject upload uri/bad expected) download!/bad (\ subject download uri/bad)] (_.cover' [/.Repository] diff --git a/stdlib/source/test/aedifex/command.lux b/stdlib/source/test/aedifex/command.lux index 0ef18f044..e0cb2da79 100644 --- a/stdlib/source/test/aedifex/command.lux +++ b/stdlib/source/test/aedifex/command.lux @@ -2,16 +2,19 @@ [lux #* ["_" test (#+ Test)]] ["." / #_ + ["#." version] + ["#." pom] + ["#." clean] ["#." install] - ["#." pom] - ["#." version]] + + ["#." deps] + ["#." deploy] + + ["#." build] + ["#." test]] {#program ["." / - ## ["#." deploy] - ## ["#." deps] - ## ["#." build] - ## ["#." test] ## ["#." auto] ]}) @@ -20,13 +23,16 @@ (<| (_.covering /._) (_.for [/.Command]) ($_ _.and + /version.test + /pom.test + /clean.test /install.test - /pom.test - /version.test - ## /deploy.test - ## /deps.test - ## /build.test - ## /test.test + + /deps.test + /deploy.test + + /build.test + /test.test ## /auto.test ))) diff --git a/stdlib/source/test/aedifex/command/build.lux b/stdlib/source/test/aedifex/command/build.lux index 8a4df9a7e..85231ae33 100644 --- a/stdlib/source/test/aedifex/command/build.lux +++ b/stdlib/source/test/aedifex/command/build.lux @@ -4,6 +4,7 @@ [abstract [monad (#+ do)]] [control + [io (#+ IO)] ["." try] ["." exception] [concurrency @@ -37,7 +38,7 @@ ["#/." resolution]]]]}) (def: #export good_shell - (-> Any (Shell Promise)) + (-> Any (Shell IO)) (shell.mock (function (_ [actual_environment actual_working_directory actual_command actual_arguments]) (#try.Success @@ -55,7 +56,7 @@ (#try.Success [state shell.normal])))))))) (def: #export bad_shell - (-> Any (Shell Promise)) + (-> Any (Shell IO)) (shell.mock (function (_ [actual_environment actual_working_directory actual_command actual_arguments]) (#try.Success @@ -98,7 +99,7 @@ (<| (_.covering /._) (do {! random.monad} [#let [fs (file.mock (\ file.default separator)) - shell (..good_shell [])] + shell (shell.async (..good_shell []))] program (random.ascii/alpha 5) target (random.ascii/alpha 5) home (random.ascii/alpha 5) @@ -162,7 +163,7 @@ resolution ..resolution] (wrap (do promise.monad [verdict (do ///action.monad - [_ (/.do! console (program.async (program.mock environment.empty home working_directory)) fs (..bad_shell []) resolution profile) + [_ (/.do! console (program.async (program.mock environment.empty home working_directory)) fs (shell.async (..bad_shell [])) resolution profile) start (!.use (\ console read_line) []) end (!.use (\ console read_line) [])] (wrap (and (text\= /.start start) diff --git a/stdlib/source/test/aedifex/command/deploy.lux b/stdlib/source/test/aedifex/command/deploy.lux index 617b3386a..cc99f2e48 100644 --- a/stdlib/source/test/aedifex/command/deploy.lux +++ b/stdlib/source/test/aedifex/command/deploy.lux @@ -17,7 +17,8 @@ ["." binary] ["." text ("#\." equivalence) ["%" format (#+ format)] - ["." encoding]] + [encoding + ["." utf8]]] ["." format #_ ["#" binary] ["." tar] @@ -108,31 +109,42 @@ (export.library fs) (\ ! map (format.run tar.writer))) - actual_pom (\ repository download (///repository/remote.uri artifact ///artifact/extension.pom)) - actual_library (\ repository download (///repository/remote.uri artifact ///artifact/extension.lux_library)) - actual_sha-1 (\ repository download (///repository/remote.uri artifact (format ///artifact/extension.lux_library ///artifact/extension.sha-1))) - actual_md5 (\ repository download (///repository/remote.uri artifact (format ///artifact/extension.lux_library ///artifact/extension.md5))) + actual_pom (\ repository download (///repository/remote.uri (get@ #///artifact.version artifact) artifact ///artifact/extension.pom)) + actual_library (\ repository download (///repository/remote.uri (get@ #///artifact.version artifact) artifact ///artifact/extension.lux_library)) + actual_sha-1 (\ repository download (///repository/remote.uri (get@ #///artifact.version artifact) artifact (format ///artifact/extension.lux_library ///artifact/extension.sha-1))) + actual_sha-1 (\ promise.monad wrap + (do try.monad + [actual_sha-1 (\ utf8.codec decode actual_sha-1)] + (\ ///hash.sha-1_codec decode actual_sha-1))) + actual_md5 (\ repository download (///repository/remote.uri (get@ #///artifact.version artifact) artifact (format ///artifact/extension.lux_library ///artifact/extension.md5))) + actual_md5 (\ promise.monad wrap + (do try.monad + [actual_md5 (\ utf8.codec decode actual_md5)] + (\ ///hash.md5_codec decode actual_md5))) - #let [deployed_library! + #let [succeeded! + (text\= //clean.success logging) + + deployed_library! (\ binary.equivalence = expected_library actual_library) deployed_pom! (\ binary.equivalence = - (|> expected_pom (\ xml.codec encode) (\ encoding.utf8 encode)) + (|> expected_pom (\ xml.codec encode) (\ utf8.codec encode)) actual_pom) deployed_sha-1! - (\ binary.equivalence = - (///hash.data (///hash.sha-1 expected_library)) + (\ ///hash.equivalence = + (///hash.sha-1 expected_library) actual_sha-1) deployed_md5! - (\ binary.equivalence = - (///hash.data (///hash.md5 expected_library)) + (\ ///hash.equivalence = + (///hash.md5 expected_library) actual_md5)]] - (wrap (and (text\= //clean.success logging) + (wrap (and succeeded! deployed_library! deployed_pom! deployed_sha-1! diff --git a/stdlib/source/test/aedifex/command/deps.lux b/stdlib/source/test/aedifex/command/deps.lux index 99856c83c..8b5e3820e 100644 --- a/stdlib/source/test/aedifex/command/deps.lux +++ b/stdlib/source/test/aedifex/command/deps.lux @@ -14,10 +14,14 @@ ["." environment]]] [data ["." text ("#\." equivalence) - ["%" format (#+ format)]] + ["%" format (#+ format)] + [encoding + ["." utf8]]] [collection ["." dictionary] - ["." set]]] + ["." set]] + [format + ["." xml]]] [math ["." random (#+ Random)]] [world @@ -81,10 +85,14 @@ dependee_package (|> dependee_package (set@ #///package.origin (#///repository/origin.Remote "")) - (set@ #///package.pom [dependee_pom #///dependency/status.Unverified])) + (set@ #///package.pom [dependee_pom + (|> dependee_pom (\ xml.codec encode) (\ utf8.codec encode)) + #///dependency/status.Unverified])) depender_package (|> depender_package (set@ #///package.origin (#///repository/origin.Remote "")) - (set@ #///package.pom [depender_pom #///dependency/status.Unverified])) + (set@ #///package.pom [depender_pom + (|> depender_pom (\ xml.codec encode) (\ utf8.codec encode)) + #///dependency/status.Unverified])) fs (file.mock (\ file.default separator)) program (program.async (program.mock environment.empty home working_directory))]] @@ -97,14 +105,29 @@ (///dependency/deployment.all local)) post (|> (\ ///.monoid identity) (set@ #///.dependencies (set.from_list ///dependency.hash (list dependee depender))) - (/.do! console local (list (///repository.mock ($///dependency/resolution.single depender_artifact depender_package) [])))) + (/.do! console local (list (///repository.mock ($///dependency/resolution.single depender_artifact depender_package) + [])))) logging! (\ ///action.monad map (text\= //clean.success) - (!.use (\ console read_line) []))] + (!.use (\ console read_line) [])) + + #let [had_dependee_before! + (set.member? pre dependee_artifact) + + lacked_depender_before! + (not (set.member? pre depender_artifact)) + + had_dependee_after! + (dictionary.key? post dependee) + + had_depender_after! + (dictionary.key? post depender)]] (wrap (and logging! - (and (set.member? pre dependee_artifact) - (not (set.member? pre depender_artifact))) - (and (dictionary.key? post dependee) - (dictionary.key? post depender)))))] + + had_dependee_before! + lacked_depender_before! + + had_dependee_after! + had_depender_after!)))] (_.cover' [/.do!] (try.default false verdict))))))) diff --git a/stdlib/source/test/aedifex/command/test.lux b/stdlib/source/test/aedifex/command/test.lux index 2d077ab87..9dd76ca08 100644 --- a/stdlib/source/test/aedifex/command/test.lux +++ b/stdlib/source/test/aedifex/command/test.lux @@ -62,7 +62,7 @@ console (@version.echo "")] (wrap (do promise.monad [verdict (do ///action.monad - [_ (/.do! console (program.async (program.mock environment.empty home working_directory)) fs (@build.good_shell []) resolution profile) + [_ (/.do! console (program.async (program.mock environment.empty home working_directory)) fs (shell.async (@build.good_shell [])) resolution profile) build_start (!.use (\ console read_line) []) build_end (!.use (\ console read_line) []) test_start (!.use (\ console read_line) []) @@ -96,7 +96,7 @@ shell.normal shell.error)])))))) [])] - _ (/.do! console (program.async (program.mock environment.empty home working_directory)) fs bad_shell resolution profile) + _ (/.do! console (program.async (program.mock environment.empty home working_directory)) fs (shell.async bad_shell) resolution profile) build_start (!.use (\ console read_line) []) build_end (!.use (\ console read_line) []) test_start (!.use (\ console read_line) []) diff --git a/stdlib/source/test/aedifex/dependency/resolution.lux b/stdlib/source/test/aedifex/dependency/resolution.lux index 4404cb32f..e9cd26a82 100644 --- a/stdlib/source/test/aedifex/dependency/resolution.lux +++ b/stdlib/source/test/aedifex/dependency/resolution.lux @@ -16,7 +16,8 @@ ["." product] ["." binary] ["." text - ["." encoding]] + [encoding + ["." utf8]]] [format ["." xml]] [collection @@ -59,38 +60,39 @@ (def: #export (single artifact package) (-> Artifact Package (Simulation Any)) - (structure - (def: (on_download uri state) - (if (text.contains? (///artifact.uri artifact) uri) - (cond (text.ends_with? ///artifact/extension.lux_library uri) - (#try.Success [state (|> package - (get@ #///package.library) - product.left)]) - - (text.ends_with? ///artifact/extension.pom uri) - (#try.Success [state (|> package - (get@ #///package.pom) - product.left - (\ xml.codec encode) - (\ encoding.utf8 encode))]) + (let [expected (///artifact.uri (get@ #///artifact.version artifact) artifact)] + (structure + (def: (on_download uri state) + (if (text.contains? expected uri) + (cond (text.ends_with? ///artifact/extension.lux_library uri) + (#try.Success [state (|> package + (get@ #///package.library) + product.left)]) + + (text.ends_with? ///artifact/extension.pom uri) + (#try.Success [state (|> package + (get@ #///package.pom) + product.left + (\ xml.codec encode) + (\ utf8.codec encode))]) - ## (text.ends_with? ///artifact/extension.sha-1 uri) - ## (#try.Success [state (|> package - ## (get@ #///package.sha-1) - ## (\ ///hash.sha-1_codec encode) - ## (\ encoding.utf8 encode))]) - - ## (text.ends_with? ///artifact/extension.md5 uri) - ## (#try.Success [state (|> package - ## (get@ #///package.md5) - ## (\ ///hash.md5_codec encode) - ## (\ encoding.utf8 encode))]) + ## (text.ends_with? ///artifact/extension.sha-1 uri) + ## (#try.Success [state (|> package + ## (get@ #///package.sha-1) + ## (\ ///hash.sha-1_codec encode) + ## (\ utf8.codec encode))]) + + ## (text.ends_with? ///artifact/extension.md5 uri) + ## (#try.Success [state (|> package + ## (get@ #///package.md5) + ## (\ ///hash.md5_codec encode) + ## (\ utf8.codec encode))]) - ## else - (#try.Failure "NOPE")) - (#try.Failure "NOPE"))) - (def: (on_upload uri binary state) - (#try.Failure "NOPE")))) + ## else + (#try.Failure "NOPE")) + (#try.Failure "NOPE"))) + (def: (on_upload uri binary state) + (#try.Failure "NOPE"))))) (def: one Test @@ -106,7 +108,7 @@ bad_sha-1 (: (Simulation Any) (structure (def: (on_download uri state) - (if (text.contains? (///artifact.uri expected_artifact) uri) + (if (text.contains? (///artifact.uri (get@ #///artifact.version expected_artifact) expected_artifact) uri) (cond (text.ends_with? ///artifact/extension.lux_library uri) (#try.Success [state (|> expected_package (get@ #///package.library) @@ -117,19 +119,19 @@ (get@ #///package.pom) product.left (\ xml.codec encode) - (\ encoding.utf8 encode))]) + (\ utf8.codec encode))]) ## (text\= extension ///artifact/extension.sha-1) ## (#try.Success [state (|> dummy_package ## (get@ #///package.sha-1) ## (\ ///hash.sha-1_codec encode) - ## (\ encoding.utf8 encode))]) + ## (\ utf8.codec encode))]) ## (text\= extension ///artifact/extension.md5) ## (#try.Success [state (|> expected_package ## (get@ #///package.md5) ## (\ ///hash.md5_codec encode) - ## (\ encoding.utf8 encode))]) + ## (\ utf8.codec encode))]) ## else (#try.Failure "NOPE")) @@ -139,7 +141,7 @@ bad_md5 (: (Simulation Any) (structure (def: (on_download uri state) - (if (text.contains? (///artifact.uri expected_artifact) uri) + (if (text.contains? (///artifact.uri (get@ #///artifact.version expected_artifact) expected_artifact) uri) (cond (text.ends_with? ///artifact/extension.lux_library uri) (#try.Success [state (|> expected_package (get@ #///package.library) @@ -150,19 +152,19 @@ (get@ #///package.pom) product.left (\ xml.codec encode) - (\ encoding.utf8 encode))]) + (\ utf8.codec encode))]) ## (text\= extension ///artifact/extension.sha-1) ## (#try.Success [state (|> expected_package ## (get@ #///package.sha-1) ## (\ ///hash.sha-1_codec encode) - ## (\ encoding.utf8 encode))]) + ## (\ utf8.codec encode))]) ## (text\= extension ///artifact/extension.md5) ## (#try.Success [state (|> dummy_package ## (get@ #///package.md5) ## (\ ///hash.md5_codec encode) - ## (\ encoding.utf8 encode))]) + ## (\ utf8.codec encode))]) ## else (#try.Failure "NOPE")) @@ -217,7 +219,7 @@ bad_sha-1 (: (Simulation Any) (structure (def: (on_download uri state) - (if (text.contains? (///artifact.uri expected_artifact) uri) + (if (text.contains? (///artifact.uri (get@ #///artifact.version expected_artifact) expected_artifact) uri) (cond (text.ends_with? ///artifact/extension.lux_library uri) (#try.Success [state (|> expected_package (get@ #///package.library) @@ -228,19 +230,19 @@ (get@ #///package.pom) product.left (\ xml.codec encode) - (\ encoding.utf8 encode))]) + (\ utf8.codec encode))]) ## (text\= extension ///artifact/extension.sha-1) ## (#try.Success [state (|> dummy_package ## (get@ #///package.sha-1) ## (\ ///hash.sha-1_codec encode) - ## (\ encoding.utf8 encode))]) + ## (\ utf8.codec encode))]) ## (text\= extension ///artifact/extension.md5) ## (#try.Success [state (|> expected_package ## (get@ #///package.md5) ## (\ ///hash.md5_codec encode) - ## (\ encoding.utf8 encode))]) + ## (\ utf8.codec encode))]) ## else (#try.Failure "NOPE")) @@ -250,7 +252,7 @@ bad_md5 (: (Simulation Any) (structure (def: (on_download uri state) - (if (text.contains? (///artifact.uri expected_artifact) uri) + (if (text.contains? (///artifact.uri (get@ #///artifact.version expected_artifact) expected_artifact) uri) (cond (text.ends_with? ///artifact/extension.lux_library uri) (#try.Success [state (|> expected_package (get@ #///package.library) @@ -261,19 +263,19 @@ (get@ #///package.pom) product.left (\ xml.codec encode) - (\ encoding.utf8 encode))]) + (\ utf8.codec encode))]) ## (text\= extension ///artifact/extension.sha-1) ## (#try.Success [state (|> expected_package ## (get@ #///package.sha-1) ## (\ ///hash.sha-1_codec encode) - ## (\ encoding.utf8 encode))]) + ## (\ utf8.codec encode))]) ## (text\= extension ///artifact/extension.md5) ## (#try.Success [state (|> dummy_package ## (get@ #///package.md5) ## (\ ///hash.md5_codec encode) - ## (\ encoding.utf8 encode))]) + ## (\ utf8.codec encode))]) ## else (#try.Failure "NOPE")) @@ -312,77 +314,77 @@ false)))) ))) -(def: all - Test - (do {! random.monad} - [dependee_artifact $///artifact.random - depender_artifact (random.filter (predicate.complement - (\ ///artifact.equivalence = dependee_artifact)) - $///artifact.random) - ignored_artifact (random.filter (predicate.complement - (predicate.unite (\ ///artifact.equivalence = dependee_artifact) - (\ ///artifact.equivalence = depender_artifact))) - $///artifact.random) +## (def: all +## Test +## (do {! random.monad} +## [dependee_artifact $///artifact.random +## depender_artifact (random.filter (predicate.complement +## (\ ///artifact.equivalence = dependee_artifact)) +## $///artifact.random) +## ignored_artifact (random.filter (predicate.complement +## (predicate.unite (\ ///artifact.equivalence = dependee_artifact) +## (\ ///artifact.equivalence = depender_artifact))) +## $///artifact.random) - [_ dependee_package] $///package.random - [_ depender_package] $///package.random - [_ ignored_package] $///package.random +## [_ dependee_package] $///package.random +## [_ depender_package] $///package.random +## [_ ignored_package] $///package.random - #let [dependee {#///dependency.artifact dependee_artifact - #///dependency.type ///artifact/type.lux_library} - depender {#///dependency.artifact depender_artifact - #///dependency.type ///artifact/type.lux_library} - ignored {#///dependency.artifact ignored_artifact - #///dependency.type ///artifact/type.lux_library} +## #let [dependee {#///dependency.artifact dependee_artifact +## #///dependency.type ///artifact/type.lux_library} +## depender {#///dependency.artifact depender_artifact +## #///dependency.type ///artifact/type.lux_library} +## ignored {#///dependency.artifact ignored_artifact +## #///dependency.type ///artifact/type.lux_library} - dependee_pom (|> (\ ///.monoid identity) - (set@ #///.identity (#.Some dependee_artifact)) - ///pom.write - try.assume) - depender_pom (|> (\ ///.monoid identity) - (set@ #///.identity (#.Some depender_artifact)) - (set@ #///.dependencies (set.from_list ///dependency.hash (list dependee))) - ///pom.write - try.assume) - ignored_pom (|> (\ ///.monoid identity) - (set@ #///.identity (#.Some ignored_artifact)) - ///pom.write - try.assume) - - dependee_package (set@ #///package.pom [dependee_pom #///dependency/status.Unverified] dependee_package) - depender_package (set@ #///package.pom [depender_pom #///dependency/status.Unverified] depender_package) - ignored_package (set@ #///package.pom [ignored_pom #///dependency/status.Unverified] ignored_package)]] - ($_ _.and - (wrap - (do promise.monad - [resolution (/.all (list (///repository.mock (..single dependee_artifact dependee_package) []) - (///repository.mock (..single depender_artifact depender_package) []) - (///repository.mock (..single ignored_artifact ignored_package) [])) - (list depender) - /.empty)] - (_.cover' [/.all] - (case resolution - (#try.Success resolution) - (and (dictionary.key? resolution depender) - (dictionary.key? resolution dependee) - (not (dictionary.key? resolution ignored))) +## dependee_pom (|> (\ ///.monoid identity) +## (set@ #///.identity (#.Some dependee_artifact)) +## ///pom.write +## try.assume) +## depender_pom (|> (\ ///.monoid identity) +## (set@ #///.identity (#.Some depender_artifact)) +## (set@ #///.dependencies (set.from_list ///dependency.hash (list dependee))) +## ///pom.write +## try.assume) +## ignored_pom (|> (\ ///.monoid identity) +## (set@ #///.identity (#.Some ignored_artifact)) +## ///pom.write +## try.assume) - (#try.Failure error) - false)))) - ))) +## dependee_package (set@ #///package.pom [dependee_pom #///dependency/status.Unverified] dependee_package) +## depender_package (set@ #///package.pom [depender_pom #///dependency/status.Unverified] depender_package) +## ignored_package (set@ #///package.pom [ignored_pom #///dependency/status.Unverified] ignored_package)]] +## ($_ _.and +## (wrap +## (do promise.monad +## [resolution (/.all (list (///repository.mock (..single dependee_artifact dependee_package) []) +## (///repository.mock (..single depender_artifact depender_package) []) +## (///repository.mock (..single ignored_artifact ignored_package) [])) +## (list depender) +## /.empty)] +## (_.cover' [/.all] +## (case resolution +## (#try.Success resolution) +## (and (dictionary.key? resolution depender) +## (dictionary.key? resolution dependee) +## (not (dictionary.key? resolution ignored))) -(def: #export test - Test - (<| (_.covering /._) - (_.for [/.Resolution]) - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) +## (#try.Failure error) +## false)))) +## ))) + +## (def: #export test +## Test +## (<| (_.covering /._) +## (_.for [/.Resolution]) +## ($_ _.and +## (_.for [/.equivalence] +## ($equivalence.spec /.equivalence ..random)) + +## (_.cover [/.empty] +## (dictionary.empty? /.empty)) - (_.cover [/.empty] - (dictionary.empty? /.empty)) - - ..one - ..any - ..all - ))) +## ..one +## ..any +## ..all +## ))) diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index ad63d30cb..69ce89d45 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -7,7 +7,6 @@ [program (#+ program:)] ["_" test (#+ Test)] ["@" target] - ["." debug] [abstract [monad (#+ do)] [predicate (#+ Predicate)]] @@ -256,5 +255,5 @@ (program: args (<| io _.run! - ((debug.private _.times') (#.Some 2,000) 100) + (_.times' (#.Some 2,000) 100) ..test)) diff --git a/stdlib/source/test/lux/macro.lux b/stdlib/source/test/lux/macro.lux index d4e3e9ae4..5892f842e 100644 --- a/stdlib/source/test/lux/macro.lux +++ b/stdlib/source/test/lux/macro.lux @@ -27,9 +27,10 @@ ["." template]]} ["." / #_ ["#." code] - ["#." template] + ["#." local] ["#." poly] - ["#." syntax]]) + ["#." syntax] + ["#." template]]) (template: (!expect <pattern> <value>) (case <value> @@ -179,7 +180,8 @@ ..expander /code.test - /template.test + /local.test /syntax.test /poly.test + /template.test ))) diff --git a/stdlib/source/test/lux/macro/local.lux b/stdlib/source/test/lux/macro/local.lux new file mode 100644 index 000000000..b499beb68 --- /dev/null +++ b/stdlib/source/test/lux/macro/local.lux @@ -0,0 +1,90 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + ["." meta] + [abstract + [monad (#+ do)]] + [control + ["." try] + ["." exception] + ["<>" parser + ["<.>" code]]] + [data + [text + ["%" format]] + [collection + ["." list] + [dictionary + ["." plist]]]] + ["." macro + [syntax (#+ syntax:)] + ["." code]] + [math + ["." random (#+ Random)] + [number + ["n" nat]]]] + {1 + ["." /]}) + +(syntax: (macro_error macro) + (function (_ compiler) + (case ((macro.expand macro) compiler) + (#try.Failure error) + (#try.Success [compiler (list (code.text error))]) + + (#try.Success _) + (#try.Failure "OOPS!")))) + +(def: (constant output) + (-> Code Macro) + ("lux macro" + (function (_ inputs lux) + (#try.Success [lux (list output)])))) + +(syntax: (with {name (<code>.tuple (<>.and <code>.text <code>.text))} + constant + {pre_remove <code>.bit} + body) + (macro.with_gensyms [g!output] + (do meta.monad + [pop! (/.push (list [name (..constant constant)])) + [module short] (meta.normalize name) + _ (if pre_remove + (let [remove_macro! (: (-> .Module .Module) + (update@ #.definitions (plist.remove short)))] + (function (_ lux) + (#try.Success [(update@ #.modules (plist.update module remove_macro!) lux) + []]))) + (wrap []))] + (let [pre_expansion (` (let [(~ g!output) (~ body)] + (exec (~ pop!) + (~ g!output))))] + (if pre_remove + (macro.expand_all pre_expansion) + (wrap (list pre_expansion))))))) + +(def: #export test + Test + (<| (_.covering /._) + (do {! random.monad} + [expected random.nat] + ($_ _.and + (_.cover [/.push] + (..with ["" "actual"] expected #0 + (n.= expected (..actual)))) + (_.cover [/.unknown_module] + (exception.match? /.unknown_module + (..macro_error + (..with ["123yolo456" "actual"] expected #0 + (n.= expected (..actual)))))) + (_.cover [/.cannot_shadow_definition] + (exception.match? /.cannot_shadow_definition + (..macro_error + (..with ["" "with"] expected #0 + (n.= expected (..actual)))))) + (_.cover [/.unknown_definition] + (exception.match? /.unknown_definition + (<| ..macro_error + (..with ["" "actual"] expected #1) + (n.= expected (..actual))))) + )))) diff --git a/stdlib/source/test/lux/macro/template.lux b/stdlib/source/test/lux/macro/template.lux index 8f85ff3ea..9f8b5af6c 100644 --- a/stdlib/source/test/lux/macro/template.lux +++ b/stdlib/source/test/lux/macro/template.lux @@ -117,10 +117,5 @@ [""]] (exception.match? /.irregular_arguments (macro_error (arity/3 "a" "b"))))) - (_.cover [/.cannot_shadow_definition] - (exception.match? /.cannot_shadow_definition - (macro_error (/.with [(macro_error <0> <1> <2>) - [""]] - "")))) ))) )) diff --git a/stdlib/source/test/lux/world.lux b/stdlib/source/test/lux/world.lux index 8b560ca40..62e0fc397 100644 --- a/stdlib/source/test/lux/world.lux +++ b/stdlib/source/test/lux/world.lux @@ -6,6 +6,8 @@ ["#." shell] ["#." console] ["#." program] + ["#." input #_ + ["#/." keyboard]] ["#." output #_ ["#/." video #_ ["#/." resolution]]]]) @@ -17,5 +19,6 @@ /shell.test /console.test /program.test + /input/keyboard.test /output/video/resolution.test )) diff --git a/stdlib/source/test/lux/world/input/keyboard.lux b/stdlib/source/test/lux/world/input/keyboard.lux new file mode 100644 index 000000000..e38ce6271 --- /dev/null +++ b/stdlib/source/test/lux/world/input/keyboard.lux @@ -0,0 +1,144 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)]] + [data + ["." bit ("#\." equivalence)] + ["." maybe] + [collection + ["." list] + ["." set (#+ Set)]]] + [math + ["." random (#+ Random)] + [number + ["n" nat]]]] + {1 + ["." /]}) + +(with_expansions [<keys> (as_is /.back_space + /.enter + /.shift + /.control + /.alt + /.caps_lock + /.escape + /.space + /.page_up + /.page_down + /.end + /.home + + /.left + /.up + /.right + /.down + + /.a + /.b + /.c + /.d + /.e + /.f + /.g + /.h + /.i + /.j + /.k + /.l + /.m + /.n + /.o + /.p + /.q + /.r + /.s + /.t + /.u + /.v + /.w + /.x + /.y + /.z + + /.num_pad_0 + /.num_pad_1 + /.num_pad_2 + /.num_pad_3 + /.num_pad_4 + /.num_pad_5 + /.num_pad_6 + /.num_pad_7 + /.num_pad_8 + /.num_pad_9 + + /.delete + /.num_lock + /.scroll_lock + /.print_screen + /.insert + /.windows + + /.f1 + /.f2 + /.f3 + /.f4 + /.f5 + /.f6 + /.f7 + /.f8 + /.f9 + /.f10 + /.f11 + /.f12 + /.f13 + /.f14 + /.f15 + /.f16 + /.f17 + /.f18 + /.f19 + /.f20 + /.f21 + /.f22 + /.f23 + /.f24)] + (def: listing + (List /.Key) + (list <keys>)) + + (def: catalogue + (Set /.Key) + (set.from_list n.hash ..listing)) + + (def: #export random + (Random /.Key) + (let [count (list.size ..listing)] + (do {! random.monad} + [choice (\ ! map (n.% count) random.nat)] + (wrap (maybe.assume (list.nth choice ..listing)))))) + + (def: #export test + Test + (<| (_.covering /._) + (_.for [/.Key]) + ($_ _.and + (_.cover [<keys>] + (n.= (list.size ..listing) + (set.size ..catalogue))) + + (_.for [/.Press] + (`` ($_ _.and + (~~ (template [<pressed?> <function>] + [(do random.monad + [key ..random + #let [sample (<function> key)]] + (_.cover [<function>] + (and (bit\= <pressed?> (get@ #/.pressed? sample)) + (n.= key (get@ #/.input sample)))))] + + [#0 /.release] + [#1 /.press] + )) + ))) + )))) diff --git a/stdlib/source/test/lux/world/output/video/resolution.lux b/stdlib/source/test/lux/world/output/video/resolution.lux index f5dcf5380..b7684ed2f 100644 --- a/stdlib/source/test/lux/world/output/video/resolution.lux +++ b/stdlib/source/test/lux/world/output/video/resolution.lux @@ -34,17 +34,20 @@ /.wuxga /.wqhd /.uhd-4k)] + (def: listing + (List /.Resolution) + (list <resolutions>)) + (def: catalogue (Set /.Resolution) - (set.from_list /.hash (list <resolutions>))) + (set.from_list /.hash ..listing)) (def: #export random (Random /.Resolution) - (let [listing (set.to_list catalogue) - count (list.size listing)] + (let [count (list.size ..listing)] (do {! random.monad} [choice (\ ! map (n.% count) random.nat)] - (wrap (maybe.assume (list.nth choice listing)))))) + (wrap (maybe.assume (list.nth choice ..listing)))))) (def: #export test Test @@ -57,7 +60,6 @@ ($hash.spec /.hash ..random)) (_.cover [<resolutions>] - (let [listing (set.to_list catalogue)] - (n.= (list.size listing) - (set.size catalogue)))) + (n.= (list.size ..listing) + (set.size ..catalogue))) )))) |