aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/control/function/mutual.lux91
-rw-r--r--stdlib/source/lux/ffi.jvm.lux12
-rw-r--r--stdlib/source/lux/ffi.old.lux12
-rw-r--r--stdlib/source/lux/macro.lux15
-rw-r--r--stdlib/source/lux/macro/local.lux105
-rw-r--r--stdlib/source/lux/macro/template.lux104
-rw-r--r--stdlib/source/lux/test.lux2
-rw-r--r--stdlib/source/lux/tool/compiler/default/init.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/default/platform.lux2
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux2
-rw-r--r--stdlib/source/lux/tool/compiler/meta/io/archive.lux6
-rw-r--r--stdlib/source/lux/world/input/keyboard.lux44
-rw-r--r--stdlib/source/lux/world/shell.lux55
13 files changed, 232 insertions, 222 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>)}
generated by cgit v1.2.3 (git 2.25.1) at 2024-08-22 23:28:07 +0000