diff options
Diffstat (limited to '')
451 files changed, 8789 insertions, 8640 deletions
diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux index 4ed6dd7aa..881848963 100644 --- a/stdlib/source/library/lux.lux +++ b/stdlib/source/library/lux.lux @@ -1444,14 +1444,14 @@ (tuple$ (list (tuple$ (list (text$ "") (nat$ 0) (nat$ 0))) content))) -(def:''' (untemplate_list tokens) +(def:''' (untemplated_list tokens) #Nil (-> ($' List Code) Code) ({#Nil (_ann (#Tag ["library/lux" "Nil"])) (#Cons [token tokens']) - (_ann (#Form (list (_ann (#Tag ["library/lux" "Cons"])) token (untemplate_list tokens'))))} + (_ann (#Form (list (_ann (#Tag ["library/lux" "Cons"])) token (untemplated_list tokens'))))} tokens)) (def:''' (list\compose xs ys) @@ -1527,7 +1527,7 @@ ## (interface: (Monad m) ## (: (All [a] (-> a (m a))) -## wrap) +## in) ## (: (All [a b] (-> (-> a (m b)) (m a) (m b))) ## bind)) ("lux def type tagged" Monad @@ -1538,13 +1538,13 @@ ($' m a) ($' m b)))))) (record$ (list)) - ["wrap" "bind"] + ["in" "bind"] #0) (def:''' maybe_monad #Nil ($' Monad Maybe) - {#wrap + {#in (function' [x] (#Some x)) #bind @@ -1556,7 +1556,7 @@ (def:''' meta_monad #Nil ($' Monad Meta) - {#wrap + {#in (function' [x] (function' [state] (#Right state x))) @@ -1573,7 +1573,7 @@ (macro:' (do tokens) ({(#Cons monad (#Cons [_ (#Tuple bindings)] (#Cons body #Nil))) - (let' [g!wrap (local_identifier$ "wrap") + (let' [g!in (local_identifier$ "in") g!bind (local_identifier$ " bind ") body' (list\fold ("lux type check" (-> (& Code Code) Code Code) (function' [binding body'] @@ -1588,7 +1588,7 @@ var)))) body (list\reverse (as_pairs bindings)))] - (return (list (form$ (list (record$ (list [(record$ (list [(tag$ ["library/lux" "wrap"]) g!wrap] [(tag$ ["library/lux" "bind"]) g!bind])) + (return (list (form$ (list (record$ (list [(record$ (list [(tag$ ["library/lux" "in"]) g!in] [(tag$ ["library/lux" "bind"]) g!bind])) body'])) monad))))) @@ -1605,15 +1605,15 @@ (-> a ($' m b)) ($' List a) ($' m ($' List b)))) - (let' [{#wrap wrap #bind _} m] + (let' [{#in in #bind _} m] ({#Nil - (wrap #Nil) + (in #Nil) (#Cons x xs') (do m [y (f x) ys (monad\map m f xs')] - (wrap (#Cons y ys)))} + (in (#Cons y ys)))} xs))) (def:''' (monad\fold m f y xs) @@ -1626,9 +1626,9 @@ b ($' List a) ($' m b))) - (let' [{#wrap wrap #bind _} m] + (let' [{#in in #bind _} m] ({#Nil - (wrap y) + (in y) (#Cons x xs') (do m @@ -1760,13 +1760,13 @@ (#Cons lastI inits) (do meta_monad [lastO ({[_ (#Form (#Cons [[_ (#Identifier ["" "~+"])] (#Cons [spliced #Nil])]))] - (wrap (as_code_list spliced)) + (in (as_code_list spliced)) _ (do meta_monad [lastO (untemplate lastI)] - (wrap (as_code_list (form$ (list (tag$ ["library/lux" "Cons"]) - (tuple$ (list lastO (tag$ ["library/lux" "Nil"]))))))))} + (in (as_code_list (form$ (list (tag$ ["library/lux" "Cons"]) + (tuple$ (list lastO (tag$ ["library/lux" "Nil"]))))))))} lastI)] (monad\fold meta_monad (function' [leftI rightO] @@ -1774,12 +1774,12 @@ (let' [g!in-module (form$ (list (text$ "lux in-module") (text$ "library/lux") (identifier$ ["library/lux" "list\compose"])))] - (wrap (form$ (list g!in-module (as_code_list spliced) rightO)))) + (in (form$ (list g!in-module (as_code_list spliced) rightO)))) _ (do meta_monad [leftO (untemplate leftI)] - (wrap (form$ (list (tag$ ["library/lux" "Cons"]) (tuple$ (list leftO rightO))))))} + (in (form$ (list (tag$ ["library/lux" "Cons"]) (tuple$ (list leftO rightO))))))} leftI)) lastO inits))} @@ -1787,10 +1787,10 @@ #0 (do meta_monad [=elems (monad\map meta_monad untemplate elems)] - (wrap (untemplate_list =elems)))} + (in (untemplated_list =elems)))} replace?)) -(def:''' (untemplate_text value) +(def:''' (untemplated_text value) #Nil (-> Text Code) (wrap_meta (form$ (list (tag$ ["library/lux" "Text"]) (text$ value))))) @@ -1814,7 +1814,7 @@ (return (wrap_meta (form$ (list (tag$ ["library/lux" "Frac"]) (frac$ value))))) [_ [_ (#Text value)]] - (return (untemplate_text value)) + (return (untemplated_text value)) [#0 [_ (#Tag [module name])]] (return (wrap_meta (form$ (list (tag$ ["library/lux" "Tag"]) (tuple$ (list (text$ module) (text$ name))))))) @@ -1832,11 +1832,11 @@ (do meta_monad [real_name ({"" (if (text\= "" subst) - (wrap [module name]) + (in [module name]) (resolve_global_identifier [subst name])) _ - (wrap [module name])} + (in [module name])} module) #let [[module name] real_name]] (return (wrap_meta (form$ (list (tag$ ["library/lux" "Identifier"]) (tuple$ (list (text$ module) (text$ name)))))))) @@ -1852,10 +1852,10 @@ [#1 [_ (#Form (#Cons [[_ (#Identifier ["" "~!"])] (#Cons [dependent #Nil])]))]] (do meta_monad [independent (untemplate replace? subst dependent)] - (wrap (wrap_meta (form$ (list (tag$ ["library/lux" "Form"]) - (untemplate_list (list (untemplate_text "lux in-module") - (untemplate_text subst) - independent))))))) + (in (wrap_meta (form$ (list (tag$ ["library/lux" "Form"]) + (untemplated_list (list (untemplated_text "lux in-module") + (untemplated_text subst) + independent))))))) [#1 [_ (#Form (#Cons [[_ (#Identifier ["" "~'"])] (#Cons [keep_quoted #Nil])]))]] (untemplate #0 subst keep_quoted) @@ -1864,13 +1864,13 @@ (do meta_monad [output (spliced replace? (untemplate replace? subst) elems) #let [[_ output'] (wrap_meta (form$ (list (tag$ ["library/lux" "Form"]) output)))]] - (wrap [meta output'])) + (in [meta output'])) [_ [meta (#Tuple elems)]] (do meta_monad [output (spliced replace? (untemplate replace? subst) elems) #let [[_ output'] (wrap_meta (form$ (list (tag$ ["library/lux" "Tuple"]) output)))]] - (wrap [meta output'])) + (in [meta output'])) [_ [_ (#Record fields)]] (do meta_monad @@ -1881,9 +1881,9 @@ (do meta_monad [=k (untemplate replace? subst k) =v (untemplate replace? subst v)] - (wrap (tuple$ (list =k =v))))))) + (in (tuple$ (list =k =v))))))) fields)] - (wrap (wrap_meta (form$ (list (tag$ ["library/lux" "Record"]) (untemplate_list =fields))))))} + (in (wrap_meta (form$ (list (tag$ ["library/lux" "Record"]) (untemplated_list =fields))))))} [replace? token])) (macro:' #export (primitive tokens) @@ -1896,7 +1896,7 @@ (return (list (form$ (list (tag$ ["library/lux" "Primitive"]) (text$ class_name) (tag$ ["library/lux" "Nil"]))))) (#Cons [_ (#Text class_name)] (#Cons [_ (#Tuple params)] #Nil)) - (return (list (form$ (list (tag$ ["library/lux" "Primitive"]) (text$ class_name) (untemplate_list params))))) + (return (list (form$ (list (tag$ ["library/lux" "Primitive"]) (text$ class_name) (untemplated_list params))))) _ (failure "Wrong syntax for primitive")} @@ -1927,9 +1927,9 @@ (do meta_monad [current_module current_module_name =template (untemplate #1 current_module template)] - (wrap (list (form$ (list (text$ "lux type check") - (identifier$ ["library/lux" "Code"]) - =template))))) + (in (list (form$ (list (text$ "lux type check") + (identifier$ ["library/lux" "Code"]) + =template))))) _ (failure "Wrong syntax for `")} @@ -1943,7 +1943,7 @@ ({(#Cons template #Nil) (do meta_monad [=template (untemplate #1 "" template)] - (wrap (list (form$ (list (text$ "lux type check") (identifier$ ["library/lux" "Code"]) =template))))) + (in (list (form$ (list (text$ "lux type check") (identifier$ ["library/lux" "Code"]) =template))))) _ (failure "Wrong syntax for `")} @@ -1957,7 +1957,7 @@ ({(#Cons template #Nil) (do meta_monad [=template (untemplate #0 "" template)] - (wrap (list (form$ (list (text$ "lux type check") (identifier$ ["library/lux" "Code"]) =template))))) + (in (list (form$ (list (text$ "lux type check") (identifier$ ["library/lux" "Code"]) =template))))) _ (failure "Wrong syntax for '")} @@ -2287,7 +2287,7 @@ #0} type)) -(def:''' (find_macro' modules current_module module name) +(def:''' (macro' modules current_module module name) #Nil (-> ($' List (& Text Module)) Text Text Text @@ -2297,7 +2297,7 @@ gdef (let' [{#module_hash _ #module_aliases _ #definitions bindings #imports _ #tags tags #types types #module_annotations _ #module_state _} ("lux type check" Module $module)] (get name bindings))] ({(#Left [r_module r_name]) - (find_macro' modules current_module r_module r_name) + (macro' modules current_module r_module r_name) (#Right [exported? def_type def_meta def_value]) (if (macro_type? def_type) @@ -2315,13 +2315,13 @@ ({["" name] (do meta_monad [module_name current_module_name] - (wrap [module_name name])) + (in [module_name name])) _ (return name)} name)) -(def:''' (find_macro full_name) +(def:''' (macro full_name) #Nil (-> Name ($' Meta ($' Maybe Macro))) (do meta_monad @@ -2333,7 +2333,7 @@ #seed seed #expected expected #location location #extensions extensions #scope_type_vars scope_type_vars} - (#Right state (find_macro' modules current_module module name))} + (#Right state (macro' modules current_module module name))} state))))) (def:''' (macro? name) @@ -2341,10 +2341,10 @@ (-> Name ($' Meta Bit)) (do meta_monad [name (normalize name) - output (find_macro name)] - (wrap ({(#Some _) #1 - #None #0} - output)))) + output (macro name)] + (in ({(#Some _) #1 + #None #0} + output)))) (def:''' (interpose sep xs) #Nil @@ -2366,7 +2366,7 @@ ({[_ (#Form (#Cons [_ (#Identifier macro_name)] args))] (do meta_monad [macro_name' (normalize macro_name) - ?macro (find_macro macro_name')] + ?macro (macro macro_name')] ({(#Some macro) (("lux type as" Macro' macro) args) @@ -2384,12 +2384,12 @@ ({[_ (#Form (#Cons [_ (#Identifier macro_name)] args))] (do meta_monad [macro_name' (normalize macro_name) - ?macro (find_macro macro_name')] + ?macro (macro macro_name')] ({(#Some macro) (do meta_monad [expansion (("lux type as" Macro' macro) args) expansion' (monad\map meta_monad macro_expand expansion)] - (wrap (list\join expansion'))) + (in (list\join expansion'))) #None (return (list token))} @@ -2405,28 +2405,28 @@ ({[_ (#Form (#Cons [_ (#Identifier macro_name)] args))] (do meta_monad [macro_name' (normalize macro_name) - ?macro (find_macro macro_name')] + ?macro (macro macro_name')] ({(#Some macro) (do meta_monad [expansion (("lux type as" Macro' macro) args) expansion' (monad\map meta_monad macro_expand_all expansion)] - (wrap (list\join expansion'))) + (in (list\join expansion'))) #None (do meta_monad [args' (monad\map meta_monad macro_expand_all args)] - (wrap (list (form$ (#Cons (identifier$ macro_name) (list\join args'))))))} + (in (list (form$ (#Cons (identifier$ macro_name) (list\join args'))))))} ?macro)) [_ (#Form members)] (do meta_monad [members' (monad\map meta_monad macro_expand_all members)] - (wrap (list (form$ (list\join members'))))) + (in (list (form$ (list\join members'))))) [_ (#Tuple members)] (do meta_monad [members' (monad\map meta_monad macro_expand_all members)] - (wrap (list (tuple$ (list\join members'))))) + (in (list (tuple$ (list\join members'))))) [_ (#Record pairs)] (do meta_monad @@ -2442,7 +2442,7 @@ (failure "The value-part of a KV-pair in a record must macro-expand to a single Code.")} val')))) pairs)] - (wrap (list (record$ pairs')))) + (in (list (record$ pairs')))) _ (return (list syntax))} @@ -2485,7 +2485,7 @@ (do meta_monad [type+ (macro_expand_all type)] ({(#Cons type' #Nil) - (wrap (list (walk_type type'))) + (in (list (walk_type type'))) _ (failure "The expansion of the type-syntax had to yield a single element.")} @@ -2762,17 +2762,17 @@ (expander init_expansion)) (do meta_monad [sub_expansion (expander branches')] - (wrap (list& (form$ (list& (identifier$ macro_name) macro_args)) - body - sub_expansion))))) + (in (list& (form$ (list& (identifier$ macro_name) macro_args)) + body + sub_expansion))))) (#Cons pattern (#Cons body branches')) (do meta_monad [sub_expansion (expander branches')] - (wrap (list& pattern body sub_expansion))) + (in (list& pattern body sub_expansion))) #Nil - (do meta_monad [] (wrap (list))) + (do meta_monad [] (in (list))) _ (failure ($_ text\compose "'lux.case' expects an even number of tokens: " (|> branches @@ -2795,7 +2795,7 @@ ({(#Cons value branches) (do meta_monad [expansion (expander branches)] - (wrap (list (` ((~ (record$ (as_pairs expansion))) (~ value)))))) + (in (list (` ((~ (record$ (as_pairs expansion))) (~ value)))))) _ (failure "Wrong syntax for case")} @@ -2818,7 +2818,7 @@ [pattern+ (macro_expand_all pattern)] (case pattern+ (#Cons pattern' #Nil) - (wrap (list& pattern' body branches)) + (in (list& pattern' body branches)) _ (failure "^ can only expand to 1 pattern."))) @@ -2952,7 +2952,7 @@ [_ (#Tuple xs)] (|> xs (list\map process_def_meta_value) - untemplate_list + untemplated_list (meta_code ["library/lux" "Tuple"])) [_ (#Record kvs)] @@ -2961,17 +2961,17 @@ (function (_ [k v]) (` [(~ (process_def_meta_value k)) (~ (process_def_meta_value v))])))) - untemplate_list + untemplated_list (meta_code ["library/lux" "Record"])) )) (def:' (process_def_meta kvs) (-> (List [Code Code]) Code) - (untemplate_list (list\map (: (-> [Code Code] Code) - (function (_ [k v]) - (` [(~ (process_def_meta_value k)) - (~ (process_def_meta_value v))]))) - kvs))) + (untemplated_list (list\map (: (-> [Code Code] Code) + (function (_ [k v]) + (` [(~ (process_def_meta_value k)) + (~ (process_def_meta_value v))]))) + kvs))) (def:' (with_func_args args meta) (-> (List Code) Code Code) @@ -3181,7 +3181,7 @@ (function (_ token) (case token (^ [_ (#Form (list [_ (#Text "lux type check")] type [_ (#Identifier ["" name])]))]) - (wrap [name type]) + (in [name type]) _ (failure "Signatures require typed members!")))) @@ -3414,7 +3414,7 @@ _ (#Some (list type)))) -(def: (find_module name) +(def: (module name) (-> Text (Meta Module)) (function (_ state) (let [{#info info #source source #current_module _ #modules modules @@ -3432,12 +3432,12 @@ (Meta Module) (do meta_monad [module_name current_module_name] - (find_module module_name))) + (module module_name))) (def: (resolve_tag [module name]) (-> Name (Meta [Nat (List Name) Bit Type])) (do meta_monad - [=module (find_module module) + [=module (..module module) #let [{#module_hash _ #module_aliases _ #definitions bindings #imports _ #tags tags_table #types types #module_annotations _ #module_state _} =module]] (case (get name tags_table) (#Some output) @@ -3460,7 +3460,7 @@ (#Named [module name] unnamed) (do meta_monad - [=module (find_module module) + [=module (..module module) #let [{#module_hash _ #module_aliases _ #definitions bindings #imports _ #tags tags #types types #module_annotations _ #module_state _} =module]] (case (get name types) (#Some [tags exported? (#Named _ _type)]) @@ -3514,7 +3514,7 @@ (^ [_ (#Form (list [_ (#Text "lux def")] [_ (#Identifier "" tag_name)] value meta [_ (#Bit #0)]))]) (case (get tag_name tag_mappings) (#Some tag) - (wrap [tag value]) + (in [tag value]) _ (failure (text\compose "Unknown implementation member: " tag_name))) @@ -3522,7 +3522,7 @@ _ (failure "Invalid implementation member.")))) (list\join tokens'))] - (wrap (list (record$ members))))) + (in (list (record$ members))))) (def: (text\join_with separator parts) (-> Text (List Text) Text) @@ -3725,13 +3725,13 @@ (^ (list& [_ (#Form (list& [_ (#Tag ["" "only"])] defs))] tokens'))) (do meta_monad [defs' (extract_defs defs)] - (wrap [(#Only defs') tokens'])) + (in [(#Only defs') tokens'])) (^or (^ (list& [_ (#Form (list& [_ (#Tag ["" "-"])] defs))] tokens')) (^ (list& [_ (#Form (list& [_ (#Tag ["" "exclude"])] defs))] tokens'))) (do meta_monad [defs' (extract_defs defs)] - (wrap [(#Exclude defs') tokens'])) + (in [(#Exclude defs') tokens'])) (^or (^ (list& [_ (#Tag ["" "*"])] tokens')) (^ (list& [_ (#Tag ["" "all"])] tokens'))) @@ -3780,7 +3780,7 @@ [index (..index_of token sample) #let [[pre post'] (text\split! index sample) [_ post] (text\split! ("lux text size" token) post')]] - (wrap [pre post]))) + (in [pre post]))) (def: (replace_all pattern replacement template) (-> Text Text Text Text) @@ -3914,17 +3914,17 @@ [_ (#Identifier ["" m_name])] (do meta_monad [m_name (clean_module nested? relative_root m_name)] - (wrap (list {#import_name m_name - #import_alias #None - #import_refer {#refer_defs #All - #refer_open (list)}}))) + (in (list {#import_name m_name + #import_alias #None + #import_refer {#refer_defs #All + #refer_open (list)}}))) ## Nested (^ [_ (#Tuple (list& [_ (#Identifier ["" m_name])] extra))]) (do meta_monad [import_name (case (normal_parallel_path relative_root m_name) (#.Some parallel_path) - (wrap parallel_path) + (in parallel_path) #.None (clean_module nested? relative_root m_name)) @@ -3933,22 +3933,22 @@ openings+extra (openings_parser extra) #let [[openings extra] openings+extra] sub_imports (imports_parser #1 import_name context_alias extra)] - (wrap (case [referral openings] - [#Nothing #Nil] - sub_imports - - _ - (list& {#import_name import_name - #import_alias #None - #import_refer {#refer_defs referral - #refer_open openings}} - sub_imports)))) + (in (case [referral openings] + [#Nothing #Nil] + sub_imports + + _ + (list& {#import_name import_name + #import_alias #None + #import_refer {#refer_defs referral + #refer_open openings}} + sub_imports)))) (^ [_ (#Tuple (list& [_ (#Text alias)] [_ (#Identifier ["" m_name])] extra))]) (do meta_monad [import_name (case (normal_parallel_path relative_root m_name) (#.Some parallel_path) - (wrap parallel_path) + (in parallel_path) #.None (clean_module nested? relative_root m_name)) @@ -3958,16 +3958,16 @@ #let [[openings extra] openings+extra de_aliased (de_alias context_alias m_name alias)] sub_imports (imports_parser #1 import_name de_aliased extra)] - (wrap (case [referral openings] - [#Ignore #Nil] - sub_imports - - _ - (list& {#import_name import_name - #import_alias (#Some de_aliased) - #import_refer {#refer_defs referral - #refer_open openings}} - sub_imports)))) + (in (case [referral openings] + [#Ignore #Nil] + sub_imports + + _ + (list& {#import_name import_name + #import_alias (#Some de_aliased) + #import_refer {#refer_defs referral + #refer_open openings}} + sub_imports)))) ## Unrecognized syntax. _ @@ -3977,7 +3977,7 @@ "Wrong syntax for import @ " current_module ..\n (code\encode token))))))) imports)] - (wrap (list\join imports')))) + (in (list\join imports')))) (def: (exported_definitions module state) (-> Text (Meta (List Text))) @@ -4047,7 +4047,7 @@ #None (f x2) (#Some y) (#Some y))) -(def: (find_in_env name state) +(def: (in_env name state) (-> Text Lux (Maybe Type)) (case state {#info info #source source #current_module _ #modules modules @@ -4070,7 +4070,7 @@ (: (List [Text [Type Any]]) closure))))) scopes))) -(def: (find_def_type name state) +(def: (definition_type name state) (-> Name Lux (Maybe Type)) (let [[v_prefix v_name] name {#info info #source source #current_module _ #modules modules @@ -4089,12 +4089,12 @@ (#Some definition) (case definition (#Left de_aliased) - (find_def_type de_aliased state) + (definition_type de_aliased state) (#Right [exported? def_type def_meta def_value]) (#Some def_type)))))) -(def: (find_def_value name state) +(def: (definition_value name state) (-> Name (Meta [Type Any])) (let [[v_prefix v_name] name {#info info #source source #current_module _ #modules modules @@ -4113,12 +4113,12 @@ (#Some definition) (case definition (#Left de_aliased) - (find_def_value de_aliased state) + (definition_value de_aliased state) (#Right [exported? def_type def_meta def_value]) (#Right [state [def_type def_value]])))))) -(def: (find_type_var idx bindings) +(def: (type_variable idx bindings) (-> Nat (List [Nat (Maybe Type)]) (Maybe Type)) (case bindings #Nil @@ -4127,27 +4127,27 @@ (#Cons [var bound] bindings') (if ("lux i64 =" idx var) bound - (find_type_var idx bindings')))) + (type_variable idx bindings')))) -(def: (find_type full_name) +(def: (type_definition full_name) (-> Name (Meta Type)) (do meta_monad [#let [[module name] full_name] current_module current_module_name] (function (_ compiler) (let [temp (if (text\= "" module) - (case (find_in_env name compiler) + (case (in_env name compiler) (#Some struct_type) (#Right [compiler struct_type]) _ - (case (find_def_type [current_module name] compiler) + (case (definition_type [current_module name] compiler) (#Some struct_type) (#Right [compiler struct_type]) _ (#Left ($_ text\compose "Unknown var: " (name\encode full_name))))) - (case (find_def_type full_name compiler) + (case (definition_type full_name compiler) (#Some struct_type) (#Right [compiler struct_type]) @@ -4160,7 +4160,7 @@ #seed _ #expected _ #location _ #extensions extensions #scope_type_vars _} compiler {#ex_counter _ #var_counter _ #var_bindings var_bindings} type_context] - (case (find_type_var type_id var_bindings) + (case (type_variable type_id var_bindings) #None temp @@ -4242,11 +4242,11 @@ (^ (list& [_ (#Form (list [_ (#Text alias)]))] body branches)) (do meta_monad [g!temp (gensym "temp")] - (wrap (list& g!temp (` (..^open (~ g!temp) (~ (text$ alias)) (~ body))) branches))) + (in (list& g!temp (` (..^open (~ g!temp) (~ (text$ alias)) (~ body))) branches))) (^ (list [_ (#Identifier name)] [_ (#Text alias)] body)) (do meta_monad - [init_type (find_type name) + [init_type (type_definition name) struct_evidence (resolve_type_tags init_type)] (case struct_evidence #None @@ -4272,12 +4272,12 @@ enhanced_target) #None - (wrap enhanced_target)))) + (in enhanced_target)))) target (zipped/2 locals members))] - (wrap (` ({(~ pattern) (~ enhanced_target)} (~ (identifier$ source))))))))) + (in (` ({(~ pattern) (~ enhanced_target)} (~ (identifier$ source))))))))) name tags&members body)] - (wrap (list full_body))))) + (in (list full_body))))) _ (failure "Wrong syntax for ^open"))) @@ -4361,7 +4361,7 @@ (do meta_monad [g!_ (gensym "_") g!record (gensym "record")] - (wrap (list (` (function ((~ g!_) (~ g!record)) (..get@ (~ selector) (~ g!record))))))) + (in (list (` (function ((~ g!_) (~ g!record)) (..get@ (~ selector) (~ g!record))))))) _ (failure "Wrong syntax for get@"))) @@ -4413,7 +4413,7 @@ (case struct [_ (#Identifier struct_name)] (do meta_monad - [struct_type (find_type struct_name) + [struct_type (type_definition struct_name) output (resolve_type_tags struct_type) #let [source (identifier$ struct_name)]] (case output @@ -4464,9 +4464,9 @@ (def: (imported_by? import_name module_name) (-> Text Text (Meta Bit)) (do meta_monad - [module (find_module module_name) + [module (module module_name) #let [{#module_hash _ #module_aliases _ #definitions _ #imports imports #tags _ #types _ #module_annotations _ #module_state _} module]] - (wrap (is_member? imports import_name)))) + (in (is_member? imports import_name)))) (def: (read_refer module_name options) (-> Text (List Code) (Meta Refer)) @@ -4478,8 +4478,8 @@ current_module current_module_name] (case options #Nil - (wrap {#refer_defs referral - #refer_open openings}) + (in {#refer_defs referral + #refer_open openings}) _ (failure ($_ text\compose "Wrong syntax for refer @ " current_module @@ -4509,19 +4509,19 @@ (do meta_monad [*defs (exported_definitions module_name) _ (test_referrals module_name *defs +defs)] - (wrap +defs)) + (in +defs)) (#Exclude _defs) (do meta_monad [*defs (exported_definitions module_name) _ (test_referrals module_name *defs _defs)] - (wrap (..only (|>> (is_member? _defs) not) *defs))) + (in (..only (|>> (is_member? _defs) not) *defs))) #Ignore - (wrap (list)) + (in (list)) #Nothing - (wrap (list))) + (in (list))) #let [defs (list\map (: (-> Text Code) (function (_ def) (` ("lux def alias" (~ (local_identifier$ def)) (~ (identifier$ [module_name def])))))) @@ -4533,7 +4533,7 @@ (` (open: (~ (text$ alias)) (~ (identifier$ [module_name name]))))) structs)))) list\join)]] - (wrap (list\compose defs openings)) + (in (list\compose defs openings)) )) (macro: #export (refer tokens) @@ -4613,7 +4613,7 @@ =module (` ("lux def module" [(~ location_code) (#.Record (~ (process_def_meta _meta)))] (~ =imports)))]] - (wrap (#Cons =module =refers)))) + (in (#Cons =module =refers)))) (macro: #export (\ tokens) {#.doc (text$ ($_ "lux text concat" @@ -4700,23 +4700,23 @@ [record (: (List (List Code)) #Nil)] pairs) accesses (list\join (list\reverse accesses'))]] - (wrap (list (` (let [(~+ accesses)] - (~ update_expr))))))) + (in (list (` (let [(~+ accesses)] + (~ update_expr))))))) (^ (list selector value)) (do meta_monad [g!_ (gensym "_") g!record (gensym "record")] - (wrap (list (` (function ((~ g!_) (~ g!record)) - (..set@ (~ selector) (~ value) (~ g!record))))))) + (in (list (` (function ((~ g!_) (~ g!record)) + (..set@ (~ selector) (~ value) (~ g!record))))))) (^ (list selector)) (do meta_monad [g!_ (gensym "_") g!value (gensym "value") g!record (gensym "record")] - (wrap (list (` (function ((~ g!_) (~ g!value) (~ g!record)) - (..set@ (~ selector) (~ g!value) (~ g!record))))))) + (in (list (` (function ((~ g!_) (~ g!value) (~ g!record)) + (..set@ (~ selector) (~ g!value) (~ g!record))))))) _ (failure "Wrong syntax for set@"))) @@ -4774,24 +4774,24 @@ (do meta_monad [g!record (gensym "record") g!temp (gensym "temp")] - (wrap (list (` (let [(~ g!record) (~ record) - (~ g!temp) (get@ [(~+ slots)] (~ g!record))] - (set@ [(~+ slots)] ((~ fun) (~ g!temp)) (~ g!record)))))))) + (in (list (` (let [(~ g!record) (~ record) + (~ g!temp) (get@ [(~+ slots)] (~ g!record))] + (set@ [(~+ slots)] ((~ fun) (~ g!temp)) (~ g!record)))))))) (^ (list selector fun)) (do meta_monad [g!_ (gensym "_") g!record (gensym "record")] - (wrap (list (` (function ((~ g!_) (~ g!record)) - (..update@ (~ selector) (~ fun) (~ g!record))))))) + (in (list (` (function ((~ g!_) (~ g!record)) + (..update@ (~ selector) (~ fun) (~ g!record))))))) (^ (list selector)) (do meta_monad [g!_ (gensym "_") g!fun (gensym "fun") g!record (gensym "record")] - (wrap (list (` (function ((~ g!_) (~ g!fun) (~ g!record)) - (..update@ (~ selector) (~ g!fun) (~ g!record))))))) + (in (list (` (function ((~ g!_) (~ g!fun) (~ g!record)) + (..update@ (~ selector) (~ g!fun) (~ g!record))))))) _ (failure "Wrong syntax for update@"))) @@ -4848,7 +4848,7 @@ (|> data' (list\map (compose apply (make_env bindings'))) list\join - wrap)) + in)) #None)))) (#Some output) (return (list\compose output branches)) @@ -4859,7 +4859,7 @@ _ (failure "Wrong syntax for ^template"))) -(def: (find_baseline_column code) +(def: (baseline_column code) (-> Code Nat) (case code (^template [<tag>] @@ -4876,14 +4876,14 @@ (^template [<tag>] [[[_ _ column] (<tag> parts)] - (list\fold n/min column (list\map find_baseline_column parts))]) + (list\fold n/min column (list\map baseline_column parts))]) ([#Form] [#Tuple]) [[_ _ column] (#Record pairs)] (list\fold n/min column - (list\compose (list\map (|>> first find_baseline_column) pairs) - (list\map (|>> second find_baseline_column) pairs))) + (list\compose (list\map (|>> first baseline_column) pairs) + (list\map (|>> second baseline_column) pairs))) )) (type: Doc_Fragment @@ -4994,7 +4994,7 @@ (text\join_with "")) (#Doc_Example example) - (let [baseline (find_baseline_column example) + (let [baseline (baseline_column example) [location _] example [_ text] (doc_example_to_text (with_baseline baseline location) baseline example)] (text\compose text __paragraph)))) @@ -5035,7 +5035,7 @@ (-> Type Code) (case type (#Primitive name params) - (` (#.Primitive (~ (text$ name)) (~ (untemplate_list (list\map type_to_code params))))) + (` (#.Primitive (~ (text$ name)) (~ (untemplated_list (list\map type_to_code params))))) (^template [<tag>] [(<tag> left right) @@ -5051,7 +5051,7 @@ (^template [<tag>] [(<tag> env type) - (let [env' (untemplate_list (list\map type_to_code env))] + (let [env' (untemplated_list (list\map type_to_code env))] (` (<tag> (~ env') (~ (type_to_code type)))))]) ([#.UnivQ] [#.ExQ]) @@ -5098,7 +5098,7 @@ (case (monad\map maybe_monad get_name inits) (#Some inits') (return inits') #None (failure "Wrong syntax for loop"))) - init_types (monad\map meta_monad find_type inits') + init_types (monad\map meta_monad type_definition inits') expected get_expected_type] (return (list (` (("lux type check" (-> (~+ (list\map type_to_code init_types)) @@ -5132,7 +5132,7 @@ (do maybe_monad [hslot (get_tag hslot') tslots (monad\map maybe_monad get_tag tslots')] - (wrap [hslot tslots]))) + (in [hslot tslots]))) (#Some slots) (return slots) @@ -5176,7 +5176,7 @@ [[location (<tag> elems)] (do maybe_monad [placements (monad\map maybe_monad (place_tokens label tokens) elems)] - (wrap (list [location (<tag> (list\join placements))])))]) + (in (list [location (<tag> (list\join placements))])))]) ([#Tuple] [#Form]) @@ -5190,12 +5190,12 @@ value' (place_tokens label tokens value)] (case [slot' value'] (^ [(list =slot) (list =value)]) - (wrap [=slot =value]) + (in [=slot =value]) _ #None)))) pairs)] - (wrap (list [location (#Record =pairs)]))) + (in (list [location (#Record =pairs)]))) )) (macro: #export (with_expansions tokens) @@ -5228,7 +5228,7 @@ [(~+ bindings')] (~+ bodies)))) (#Some output) - (wrap output) + (in output) _ (failure "[with_expansions] Improper macro expansion."))) @@ -5264,12 +5264,12 @@ (def: (anti_quote_def name) (-> Name (Meta Code)) (do meta_monad - [type+value (find_def_value name) + [type+value (definition_value name) #let [[type value] type+value]] (case (flat_alias type) (^template [<name> <type> <wrapper>] [(#Named ["library/lux" <name>] _) - (wrap (<wrapper> (:as <type> value)))]) + (in (<wrapper> (:as <type> value)))]) (["Bit" Bit bit$] ["Nat" Nat nat$] ["Int" Int int$] @@ -5294,7 +5294,7 @@ [[meta (<tag> parts)] (do meta_monad [=parts (monad\map meta_monad anti_quote parts)] - (wrap [meta (<tag> =parts)]))]) + (in [meta (<tag> =parts)]))]) ([#Form] [#Tuple]) @@ -5305,14 +5305,14 @@ (function (_ [slot value]) (do meta_monad [=value (anti_quote value)] - (wrap [slot =value])))) + (in [slot =value])))) pairs)] - (wrap [meta (#Record =pairs)])) + (in [meta (#Record =pairs)])) _ (\ meta_monad return token) ## TODO: Figure out why this doesn't work: - ## (\ meta_monad wrap token) + ## (\ meta_monad in token) )) (macro: #export (static tokens) @@ -5320,7 +5320,7 @@ (^ (list pattern)) (do meta_monad [pattern' (anti_quote pattern)] - (wrap (list pattern'))) + (in (list pattern'))) _ (failure "Wrong syntax for 'static'."))) @@ -5347,7 +5347,7 @@ (#Cons init extras) (do meta_monad [extras' (monad\map meta_monad case_level^ extras)] - (wrap [init extras'])))) + (in [init extras'])))) (def: (multi_level_case$ g!_ [[init_pattern levels] body]) (-> Code [Multi_Level_Case Code] (List Code)) @@ -5416,7 +5416,7 @@ (~+ (if initial_bind? (list) (list g!temp (` #.None)))))))))] - (wrap output))) + (in output))) _ (failure "Wrong syntax for ^multi"))) @@ -5468,7 +5468,7 @@ [stvs get_scope_type_vars] (case (..nth idx (list\reverse stvs)) (#Some var_id) - (wrap (list (` (#Ex (~ (nat$ var_id)))))) + (in (list (` (#Ex (~ (nat$ var_id)))))) #None (failure (text\compose "Indexed-type does not exist: " (nat\encode idx))))) @@ -5526,7 +5526,7 @@ (^ (list expr)) (do meta_monad [type get_expected_type] - (wrap (list (` ("lux type as" (~ (type_to_code type)) (~ expr)))))) + (in (list (` ("lux type as" (~ (type_to_code type)) (~ expr)))))) _ (failure (..wrong_syntax_error (name_of ..:assume))))) @@ -5551,7 +5551,7 @@ #let [[module line column] location location ($_ "lux text concat" (text\encode module) "," (nat\encode line) "," (nat\encode column)) message ($_ "lux text concat" "Undefined behavior @ " location)]] - (wrap (list (` (..error! (~ (text$ message))))))) + (in (list (` (..error! (~ (text$ message))))))) _ (failure (..wrong_syntax_error (name_of ..undefined))))) @@ -5571,14 +5571,14 @@ (case tokens (^ (list [_ (#Identifier var_name)])) (do meta_monad - [var_type (find_type var_name)] - (wrap (list (type_to_code var_type)))) + [var_type (type_definition var_name)] + (in (list (type_to_code var_type)))) (^ (list expression)) (do meta_monad [g!temp (gensym "g!temp")] - (wrap (list (` (let [(~ g!temp) (~ expression)] - (..:of (~ g!temp))))))) + (in (list (` (let [(~ g!temp) (~ expression)] + (..:of (~ g!temp))))))) _ (failure (..wrong_syntax_error (name_of ..:of))))) @@ -5592,12 +5592,12 @@ (function (_ arg') (case arg' [_ (#Identifier ["" arg_name])] - (wrap arg_name) + (in arg_name) _ (failure "Could not parse an argument."))) args')] - (wrap [[name args] tokens'])) + (in [[name args] tokens'])) _ (failure "Could not parse a complex declaration.") @@ -5664,19 +5664,19 @@ [arg (` ((~' ~) (~ (local_identifier$ arg))))]) args)] this_module current_module_name] - (wrap (list (` (macro: (~+ (export export?)) - ((~ (local_identifier$ name)) (~ g!tokens) (~ g!compiler)) - (~ anns) - (case (~ g!tokens) - (^ (list (~+ (list\map local_identifier$ args)))) - (#.Right [(~ g!compiler) - (list (~+ (list\map (function (_ template) - (` (`' (~ (replace_syntax rep_env template))))) - input_templates)))]) - - (~ g!_) - (#.Left (~ (text$ (..wrong_syntax_error [this_module name])))) - ))))) + (in (list (` (macro: (~+ (export export?)) + ((~ (local_identifier$ name)) (~ g!tokens) (~ g!compiler)) + (~ anns) + (case (~ g!tokens) + (^ (list (~+ (list\map local_identifier$ args)))) + (#.Right [(~ g!compiler) + (list (~+ (list\map (function (_ template) + (` (`' (~ (replace_syntax rep_env template))))) + input_templates)))]) + + (~ g!_) + (#.Left (~ (text$ (..wrong_syntax_error [this_module name])))) + ))))) )) (macro: #export (as_is tokens compiler) @@ -5707,12 +5707,12 @@ [_ (#Identifier identifier)] (do meta_monad [identifier (..resolve_global_identifier identifier) - type+value (..find_def_value identifier) + type+value (..definition_value identifier) #let [[type value] type+value]] (case (..flat_alias type) (^or (#Primitive "#Text" #Nil) (#Named ["library/lux" "Text"] (#Primitive "#Text" #Nil))) - (wrap (:as ..Text value)) + (in (:as ..Text value)) _ (failure ($_ text\compose @@ -5770,14 +5770,14 @@ (^ [ann (#Form (list [_ (#Identifier ["" "~~"])] expansion))]) (do meta_monad [g!expansion (gensym "g!expansion")] - (wrap [(list [g!expansion expansion]) g!expansion])) + (in [(list [g!expansion expansion]) g!expansion])) (^template [<tag>] [[ann (<tag> parts)] (do meta_monad [=parts (monad\map meta_monad label_code parts)] - (wrap [(list\fold list\compose (list) (list\map left =parts)) - [ann (<tag> (list\map right =parts))]]))]) + (in [(list\fold list\compose (list) (list\map left =parts)) + [ann (<tag> (list\map right =parts))]]))]) ([#Form] [#Tuple]) [ann (#Record kvs)] @@ -5789,10 +5789,10 @@ =val (label_code val) #let [[key_labels key_labelled] =key [val_labels val_labelled] =val]] - (wrap [(list\compose key_labels val_labels) [key_labelled val_labelled]]))) + (in [(list\compose key_labels val_labels) [key_labelled val_labelled]]))) kvs)] - (wrap [(list\fold list\compose (list) (list\map left =kvs)) - [ann (#Record (list\map right =kvs))]])) + (in [(list\fold list\compose (list) (list\map left =kvs)) + [ann (#Record (list\map right =kvs))]])) _ (return [(list) code]))) @@ -5803,10 +5803,10 @@ (do meta_monad [=raw (label_code raw) #let [[labels labelled] =raw]] - (wrap (list (` (with_expansions [(~+ (|> labels - (list\map (function (_ [label expansion]) (list label expansion))) - list\join))] - (~ labelled)))))) + (in (list (` (with_expansions [(~+ (|> labels + (list\map (function (_ [label expansion]) (list label expansion))) + list\join))] + (~ labelled)))))) _ (failure (..wrong_syntax_error (name_of ..``))) @@ -5816,56 +5816,56 @@ (-> Name Code) (` [(~ (text$ module)) (~ (text$ name))])) -(def: (untemplate_list& last inits) +(def: (untemplated_list& last inits) (-> Code (List Code) Code) (case inits #Nil last (#Cons [init inits']) - (` (#.Cons (~ init) (~ (untemplate_list& last inits')))))) + (` (#.Cons (~ init) (~ (untemplated_list& last inits')))))) -(def: (untemplate_record g!meta untemplate_pattern fields) +(def: (untemplated_record g!meta untemplated_pattern fields) (-> Code (-> Code (Meta Code)) (-> (List [Code Code]) (Meta Code))) (do meta_monad [=fields (monad\map meta_monad (function (_ [key value]) (do meta_monad - [=key (untemplate_pattern key) - =value (untemplate_pattern value)] - (wrap (` [(~ =key) (~ =value)])))) + [=key (untemplated_pattern key) + =value (untemplated_pattern value)] + (in (` [(~ =key) (~ =value)])))) fields)] - (wrap (` [(~ g!meta) (#.Record (~ (untemplate_list =fields)))])))) + (in (` [(~ g!meta) (#.Record (~ (untemplated_list =fields)))])))) (template [<tag> <name>] - [(def: (<name> g!meta untemplate_pattern elems) + [(def: (<name> g!meta untemplated_pattern elems) (-> Code (-> Code (Meta Code)) (-> (List Code) (Meta Code))) (case (list\reverse elems) (#Cons [_ (#Form (#Cons [[_ (#Identifier ["" "~+"])] (#Cons [spliced #Nil])]))] inits) (do meta_monad - [=inits (monad\map meta_monad untemplate_pattern (list\reverse inits))] - (wrap (` [(~ g!meta) (<tag> (~ (untemplate_list& spliced =inits)))]))) + [=inits (monad\map meta_monad untemplated_pattern (list\reverse inits))] + (in (` [(~ g!meta) (<tag> (~ (untemplated_list& spliced =inits)))]))) _ (do meta_monad - [=elems (monad\map meta_monad untemplate_pattern elems)] - (wrap (` [(~ g!meta) (<tag> (~ (untemplate_list =elems)))])))))] + [=elems (monad\map meta_monad untemplated_pattern elems)] + (in (` [(~ g!meta) (<tag> (~ (untemplated_list =elems)))])))))] - [#.Tuple untemplate_tuple] - [#.Form untemplate_form] + [#.Tuple untemplated_tuple] + [#.Form untemplated_form] ) -(def: (untemplate_pattern pattern) +(def: (untemplated_pattern pattern) (-> Code (Meta Code)) (do meta_monad [g!meta (gensym "g!meta")] (case pattern (^template [<tag> <gen>] [[_ (<tag> value)] - (wrap (` [(~ g!meta) (<tag> (~ (<gen> value)))]))]) + (in (` [(~ g!meta) (<tag> (~ (<gen> value)))]))]) ([#.Bit bit$] [#.Nat nat$] [#.Int int$] @@ -5883,25 +5883,25 @@ (^template [<tag> <untemplate>] [[_ (<tag> elems)] - (<untemplate> g!meta untemplate_pattern elems)]) - ([#.Tuple ..untemplate_tuple] - [#.Form ..untemplate_form]) + (<untemplate> g!meta untemplated_pattern elems)]) + ([#.Tuple ..untemplated_tuple] + [#.Form ..untemplated_form]) [_ (#Record fields)] - (..untemplate_record g!meta untemplate_pattern fields) + (..untemplated_record g!meta untemplated_pattern fields) ))) (macro: #export (^code tokens) (case tokens (^ (list& [_meta (#Form (list template))] body branches)) (do meta_monad - [pattern (untemplate_pattern template)] - (wrap (list& pattern body branches))) + [pattern (untemplated_pattern template)] + (in (list& pattern body branches))) (^ (list template)) (do meta_monad - [pattern (untemplate_pattern template)] - (wrap (list pattern))) + [pattern (untemplated_pattern template)] + (in (list pattern))) _ (failure (..wrong_syntax_error (name_of ..^code))))) @@ -5940,9 +5940,9 @@ (^ (list expression)) (do meta_monad [g!_ (gensym "g!_")] - (wrap (list (` ("lux try" - (.function ((~ g!_) (~ g!_)) - (~ expression))))))) + (in (list (` ("lux try" + (.function ((~ g!_) (~ g!_)) + (~ expression))))))) _ (..failure (..wrong_syntax_error (name_of ..try))))) diff --git a/stdlib/source/library/lux/abstract/apply.lux b/stdlib/source/library/lux/abstract/apply.lux index da787a54a..38e4772e4 100644 --- a/stdlib/source/library/lux/abstract/apply.lux +++ b/stdlib/source/library/lux/abstract/apply.lux @@ -25,13 +25,13 @@ (def: (apply fgf fgx) ## TODO: Switch from this version to the one below (in comments) ASAP. (let [fgf' (\ f_apply apply - (\ f_monad wrap (\ g_apply apply)) + (\ f_monad in (\ g_apply apply)) fgf)] (\ f_apply apply fgf' fgx)) ## (let [applyF (\ f_apply apply) ## applyG (\ g_apply apply)] ## ($_ applyF - ## (\ f_monad wrap applyG) + ## (\ f_monad in applyG) ## fgf ## fgx)) )) diff --git a/stdlib/source/library/lux/abstract/comonad.lux b/stdlib/source/library/lux/abstract/comonad.lux index 362556f50..205958b26 100644 --- a/stdlib/source/library/lux/abstract/comonad.lux +++ b/stdlib/source/library/lux/abstract/comonad.lux @@ -19,7 +19,7 @@ &functor) (: (All [a] (-> (w a) a)) - unwrap) + out) (: (All [a] (-> (w a) (w (w a)))) split)) @@ -64,13 +64,13 @@ (#.Some name) (let [name [location.dummy (#.Identifier ["" name])]] (` ({(~ name) - ({[(~ g!map) (~' unwrap) (~ g!split)] + ({[(~ g!map) (~' out) (~ g!split)] (~ body')} (~ name))} (~ comonad)))) #.None - (` ({[(~ g!map) (~' unwrap) (~ g!split)] + (` ({[(~ g!map) (~' out) (~ g!split)] (~ body')} (~ comonad)))))])) (#.Left "'be' bindings must have an even number of parts.")) diff --git a/stdlib/source/library/lux/abstract/comonad/cofree.lux b/stdlib/source/library/lux/abstract/comonad/cofree.lux index 88c4ce50a..096a48feb 100644 --- a/stdlib/source/library/lux/abstract/comonad/cofree.lux +++ b/stdlib/source/library/lux/abstract/comonad/cofree.lux @@ -20,7 +20,7 @@ (def: &functor (..functor dsl)) - (def: (unwrap [head tail]) + (def: (out [head tail]) head) (def: (split [head tail]) diff --git a/stdlib/source/library/lux/abstract/monad.lux b/stdlib/source/library/lux/abstract/monad.lux index 567234801..4dc1e1477 100644 --- a/stdlib/source/library/lux/abstract/monad.lux +++ b/stdlib/source/library/lux/abstract/monad.lux @@ -51,7 +51,7 @@ &functor) (: (All [a] (-> a (m a))) - wrap) + in) (: (All [a] (-> (m (m a)) (m a))) join)) @@ -61,7 +61,7 @@ (do monad [y (f1 x) z (f2 z)] - (wrap (f3 z))))} + (in (f3 z))))} (case (: (Maybe [(Maybe Text) Code (List Code) Code]) (case tokens (^ (list [_ (#.Record (list [[_ (#.Identifier ["" name])] monad]))] [_ (#.Tuple bindings)] body)) @@ -96,13 +96,13 @@ (#.Some name) (let [name [location.dummy (#.Identifier ["" name])]] (` ({(~ name) - ({[(~ g!map) (~' wrap) (~ g!join)] + ({[(~ g!map) (~' in) (~ g!join)] (~ body')} (~ name))} (~ monad)))) #.None - (` ({[(~ g!map) (~' wrap) (~ g!join)] + (` ({[(~ g!map) (~' in) (~ g!join)] (~ body')} (~ monad)))))])) (#.Left "'do' bindings must have an even number of parts.")) @@ -127,7 +127,7 @@ (function (recur xs) (case xs #.Nil - (!\wrap #.Nil) + (!\in #.Nil) (#.Cons x xs') (|> x @@ -144,7 +144,7 @@ (function (recur xs) (case xs #.Nil - (!\wrap #.Nil) + (!\in #.Nil) (#.Cons x xs') (|> (f x) @@ -161,7 +161,7 @@ (function (recur xs) (case xs #.Nil - (!\wrap #.Nil) + (!\in #.Nil) (#.Cons head xs') (|> (f head) @@ -180,7 +180,7 @@ (M a))) (case xs #.Nil - (\ monad wrap init) + (\ monad in init) (#.Cons x xs') (do monad diff --git a/stdlib/source/library/lux/abstract/monad/free.lux b/stdlib/source/library/lux/abstract/monad/free.lux index 9648fbc8e..a4f5733df 100644 --- a/stdlib/source/library/lux/abstract/monad/free.lux +++ b/stdlib/source/library/lux/abstract/monad/free.lux @@ -48,7 +48,7 @@ (def: &functor (..functor dsl)) - (def: (wrap a) + (def: (in a) (#Pure a)) (def: (join efefa) diff --git a/stdlib/source/library/lux/abstract/monad/indexed.lux b/stdlib/source/library/lux/abstract/monad/indexed.lux index 5d18ba0ac..8fbd74b1f 100644 --- a/stdlib/source/library/lux/abstract/monad/indexed.lux +++ b/stdlib/source/library/lux/abstract/monad/indexed.lux @@ -15,7 +15,7 @@ (interface: #export (IxMonad m) (: (All [p a] (-> a (m p p a))) - wrap) + in) (: (All [ii it io vi vo] (-> (-> vi (m it io vo)) @@ -71,15 +71,15 @@ (~ value))))) expression (list.reverse context))] - (wrap (list (case ?name - (#.Some name) - (let [name (code.local_identifier name)] - (` (let [(~ name) (~ monad) - {#..wrap (~' wrap) - #..bind (~ g!bind)} (~ name)] - (~ body)))) + (in (list (case ?name + (#.Some name) + (let [name (code.local_identifier name)] + (` (let [(~ name) (~ monad) + {#..in (~' in) + #..bind (~ g!bind)} (~ name)] + (~ body)))) - #.None - (` (let [{#..wrap (~' wrap) - #..bind (~ g!bind)} (~ monad)] - (~ body))))))))) + #.None + (` (let [{#..in (~' in) + #..bind (~ g!bind)} (~ monad)] + (~ body))))))))) diff --git a/stdlib/source/library/lux/abstract/predicate.lux b/stdlib/source/library/lux/abstract/predicate.lux index d53a9a3cb..1d1bfd848 100644 --- a/stdlib/source/library/lux/abstract/predicate.lux +++ b/stdlib/source/library/lux/abstract/predicate.lux @@ -1,6 +1,6 @@ (.module: [library - [lux #* + [lux (#- or and) [control ["." function]]]] [// @@ -26,10 +26,10 @@ (<composition> (left value) (right value))))] - [none #0 unite or + [none #0 or .or (doc "A predicate that always fails.") (doc "A predicate that meets either predecessor.")] - [all #1 intersect and + [all #1 and .and (doc "A predicate that always succeeds.") (doc "A predicate that meets both predecessors.")] ) @@ -41,8 +41,8 @@ (def: identity <identity>) (def: compose <composition>))] - [union ..none ..unite] - [intersection ..all ..intersect] + [union ..none ..or] + [intersection ..all ..and] ) (def: #export (complement predicate) @@ -54,8 +54,8 @@ {#.doc (doc "A predicate that meeds 'base', but not 'sub'.")} (All [a] (-> (Predicate a) (Predicate a) (Predicate a))) (function (_ value) - (and (base value) - (not (sub value))))) + (.and (base value) + (not (sub value))))) (def: #export (rec predicate) {#.doc (doc "Ties the knot for a recursive predicate.")} diff --git a/stdlib/source/library/lux/control/concatenative.lux b/stdlib/source/library/lux/control/concatenative.lux index 0d87210c3..f8426ebb7 100644 --- a/stdlib/source/library/lux/control/concatenative.lux +++ b/stdlib/source/library/lux/control/concatenative.lux @@ -47,7 +47,7 @@ (<>.either (<>.and (<>.maybe bottom^) (<c>.tuple (<>.some <c>.any))) (<>.and (|> bottom^ (<>\map (|>> #.Some))) - (<>\wrap (list))))) + (<>\in (list))))) (def: (stack_fold tops bottom) (-> (List Code) Code Code) @@ -62,7 +62,7 @@ [expansion expander] (case expansion (#.Cons singleton #.Nil) - (wrap singleton) + (in singleton) _ (meta.failure (format "Cannot expand to more than a single AST/Code node:" text.new_line @@ -82,17 +82,17 @@ (monad.do meta.monad [inputC (singleton (macro.expand_all (stack_fold (get@ #top inputs) bottomI))) outputC (singleton (macro.expand_all (stack_fold (get@ #top outputs) bottomO)))] - (wrap (list (` (-> (~ (de_alias inputC)) - (~ (de_alias outputC))))))) + (in (list (` (-> (~ (de_alias inputC)) + (~ (de_alias outputC))))))) [?bottomI ?bottomO] (with_gensyms [g!stack] (monad.do meta.monad [inputC (singleton (macro.expand_all (stack_fold (get@ #top inputs) (maybe.default g!stack ?bottomI)))) outputC (singleton (macro.expand_all (stack_fold (get@ #top outputs) (maybe.default g!stack ?bottomO))))] - (wrap (list (` (All [(~ g!stack)] - (-> (~ (de_alias inputC)) - (~ (de_alias outputC)))))))))))) + (in (list (` (All [(~ g!stack)] + (-> (~ (de_alias inputC)) + (~ (de_alias outputC)))))))))))) (def: begin! Any []) @@ -102,7 +102,7 @@ top)) (syntax: #export (||> {commands (<>.some <c>.any)}) - (wrap (list (` (|> (~! ..begin!) (~+ commands) ((~! ..end!))))))) + (in (list (` (|> (~! ..begin!) (~+ commands) ((~! ..end!))))))) (syntax: #export (word: {export |export|.parser} @@ -110,21 +110,21 @@ {annotations (<>.default |annotations|.empty |annotations|.parser)} type {commands (<>.some <c>.any)}) - (wrap (list (` (def: (~+ (|export|.format export)) (~ (code.local_identifier name)) - (~ (|annotations|.format annotations)) - (~ type) - (|>> (~+ commands))))))) + (in (list (` (def: (~+ (|export|.format export)) (~ (code.local_identifier name)) + (~ (|annotations|.format annotations)) + (~ type) + (|>> (~+ commands))))))) (syntax: #export (apply {arity (|> <c>.nat (<>.only (n.> 0)))}) (with_gensyms [g! g!func g!stack g!output] (monad.do {! meta.monad} [g!inputs (|> (macro.gensym "input") (list.repeat arity) (monad.seq !))] - (wrap (list (` (: (All [(~+ g!inputs) (~ g!output)] - (-> (-> (~+ g!inputs) (~ g!output)) - (=> [(~+ g!inputs)] [(~ g!output)]))) - (function ((~ g!) (~ g!func)) - (function ((~ g!) (~ (stack_fold g!inputs g!stack))) - [(~ g!stack) ((~ g!func) (~+ g!inputs))]))))))))) + (in (list (` (: (All [(~+ g!inputs) (~ g!output)] + (-> (-> (~+ g!inputs) (~ g!output)) + (=> [(~+ g!inputs)] [(~ g!output)]))) + (function ((~ g!) (~ g!func)) + (function ((~ g!) (~ (stack_fold g!inputs g!stack))) + [(~ g!stack) ((~ g!func) (~+ g!inputs))]))))))))) (def: #export apply/1 (apply 1)) (def: #export apply/2 (apply 2)) diff --git a/stdlib/source/library/lux/control/concurrency/actor.lux b/stdlib/source/library/lux/control/concurrency/actor.lux index b2b619735..5b954efcd 100644 --- a/stdlib/source/library/lux/control/concurrency/actor.lux +++ b/stdlib/source/library/lux/control/concurrency/actor.lux @@ -62,7 +62,7 @@ (pending tail)) #.None - (wrap #.Nil)))) + (in #.Nil)))) (abstract: #export (Actor s) {#obituary [(Async <Obituary>) @@ -107,7 +107,7 @@ (do io.monad [pending (..pending tail)] (resolve [error state (#.Cons head pending)]))) - (wrap []))) + (in []))) (#try.Success state') (recur state' tail))))] @@ -156,12 +156,12 @@ (if resolved? (do ! [_ (atom.write (product.right entry) (get@ #mailbox (:representation actor)))] - (wrap (exception.return []))) + (in (exception.return []))) (recur |mailbox|&resolve))) (#.Some [_ |mailbox|']) (recur |mailbox|')))))) - (wrap (exception.throw ..dead []))))) + (in (exception.except ..dead []))))) (type: #export (Message s o) {#.doc (doc "A two-way message sent to an actor, expecting a reply.")} @@ -200,7 +200,7 @@ async (#try.Failure error) - (wrap (#try.Failure error)))))) + (in (#try.Failure error)))))) ) ) @@ -219,13 +219,13 @@ "but allows the actor to handle previous mail.")} (All [s] (-> (Actor s) (IO (Try Any)))) (..mail! (function (_ state self) - (async.resolved (exception.throw ..poisoned []))) + (async.resolved (exception.except ..poisoned []))) actor)) (def: actor_decl^ (Parser [Text (List Text)]) (<>.either (<code>.form (<>.and <code>.local_identifier (<>.some <code>.local_identifier))) - (<>.and <code>.local_identifier (\ <>.monad wrap (list))))) + (<>.and <code>.local_identifier (\ <>.monad in (list))))) (type: On_MailC [[Text Text Text] Code]) @@ -266,7 +266,7 @@ [#let [_ (debug.log! "BEFORE")] output (mail state self) #let [_ (debug.log! "AFTER")]] - (wrap output))) + (in output))) (message: #export (push {value a} state self) (List a) @@ -298,16 +298,16 @@ [g!type (macro.gensym (format name "_abstract_type")) #let [g!actor (code.local_identifier name) g!vars (list\map code.local_identifier vars)]] - (wrap (list (` ((~! abstract:) (~+ (|export|.format export)) ((~ g!type) (~+ g!vars)) - (~ state_type) + (in (list (` ((~! abstract:) (~+ (|export|.format export)) ((~ g!type) (~+ g!vars)) + (~ state_type) - (def: (~+ (|export|.format export)) (~ g!actor) - (All [(~+ g!vars)] - (..Behavior (~ state_type) ((~ g!type) (~+ g!vars)))) - {#..on_init (|>> ((~! abstract.:abstraction) (~ g!type))) - #..on_mail (~ (..on_mail g!_ ?on_mail))}) + (def: (~+ (|export|.format export)) (~ g!actor) + (All [(~+ g!vars)] + (..Behavior (~ state_type) ((~ g!type) (~+ g!vars)))) + {#..on_init (|>> ((~! abstract.:abstraction) (~ g!type))) + #..on_mail (~ (..on_mail g!_ ?on_mail))}) - (~+ messages)))))))) + (~+ messages)))))))) (syntax: #export (actor {[state_type init] (<code>.record (<>.and <code>.any <code>.any))} {[?on_mail messages] behavior^}) @@ -318,12 +318,12 @@ ((on_mail message state self) (message (inc state) self))))} (with_gensyms [g!_] - (wrap (list (` (: ((~! io.IO) (..Actor (~ state_type))) - (..spawn! (: (..Behavior (~ state_type) (~ state_type)) - {#..on_init (|>>) - #..on_mail (~ (..on_mail g!_ ?on_mail))}) - (: (~ state_type) - (~ init))))))))) + (in (list (` (: ((~! io.IO) (..Actor (~ state_type))) + (..spawn! (: (..Behavior (~ state_type) (~ state_type)) + {#..on_init (|>>) + #..on_mail (~ (..on_mail g!_ ?on_mail))}) + (: (~ state_type) + (~ init))))))))) (type: Signature {#vars (List Text) @@ -344,7 +344,7 @@ (def: reference^ (Parser [Name (List Text)]) (<>.either (<code>.form (<>.and <code>.identifier (<>.some <code>.local_identifier))) - (<>.and <code>.identifier (\ <>.monad wrap (list))))) + (<>.and <code>.identifier (\ <>.monad in (list))))) (syntax: #export (message: {export |export|.parser} @@ -369,21 +369,21 @@ g!inputsT (|> signature (get@ #inputs) (list\map product.right)) g!state (|> signature (get@ #state) code.local_identifier) g!self (|> signature (get@ #self) code.local_identifier)]] - (wrap (list (` (def: (~+ (|export|.format export)) ((~ g!message) (~+ g!inputsC)) - (~ (|annotations|.format annotations)) - (All [(~+ g!all_vars)] - (-> (~+ g!inputsT) - (..Message (~ (get@ #abstract.abstraction actor_scope)) - (~ output_type)))) - (function ((~ g!_) (~ g!state) (~ g!self)) - (let [(~ g!state) (:as (~ (get@ #abstract.representation actor_scope)) - (~ g!state))] - (|> (~ body) - (: ((~! async.Async) ((~! try.Try) [(~ (get@ #abstract.representation actor_scope)) - (~ output_type)]))) - (:as ((~! async.Async) ((~! try.Try) [(~ (get@ #abstract.abstraction actor_scope)) - (~ output_type)])))))))) - )))))) + (in (list (` (def: (~+ (|export|.format export)) ((~ g!message) (~+ g!inputsC)) + (~ (|annotations|.format annotations)) + (All [(~+ g!all_vars)] + (-> (~+ g!inputsT) + (..Message (~ (get@ #abstract.abstraction actor_scope)) + (~ output_type)))) + (function ((~ g!_) (~ g!state) (~ g!self)) + (let [(~ g!state) (:as (~ (get@ #abstract.representation actor_scope)) + (~ g!state))] + (|> (~ body) + (: ((~! async.Async) ((~! try.Try) [(~ (get@ #abstract.representation actor_scope)) + (~ output_type)]))) + (:as ((~! async.Async) ((~! try.Try) [(~ (get@ #abstract.abstraction actor_scope)) + (~ output_type)])))))))) + )))))) (type: #export Stop {#.doc (doc "A signal to stop an actor from observing a channel.")} @@ -408,5 +408,5 @@ (|> actor (..mail! (action event stop)) (\ ! map try.maybe)) - (wrap #.None)))) + (in #.None)))) channel))) diff --git a/stdlib/source/library/lux/control/concurrency/async.lux b/stdlib/source/library/lux/control/concurrency/async.lux index 875602eff..68a586914 100644 --- a/stdlib/source/library/lux/control/concurrency/async.lux +++ b/stdlib/source/library/lux/control/concurrency/async.lux @@ -36,7 +36,7 @@ [(^@ old [_value _observers]) (atom.read async)] (case _value (#.Some _) - (wrap #0) + (in #0) #.None (do ! @@ -46,7 +46,7 @@ (do ! [_ (monad.map ! (function (_ f) (f value)) _observers)] - (wrap #1)) + (in #1)) (resolve value)))))))) (def: #export (resolved value) @@ -82,7 +82,7 @@ (do ! [swapped? (atom.compare_and_swap old new async)] (if swapped? - (wrap []) + (in []) (await f (:abstraction async)))))))) ) @@ -122,7 +122,7 @@ (def: &functor ..functor) - (def: wrap ..resolved) + (def: in ..resolved) (def: (join mma) (let [[ma resolve] (async [])] diff --git a/stdlib/source/library/lux/control/concurrency/atom.lux b/stdlib/source/library/lux/control/concurrency/atom.lux index ba1d2af55..138e03e02 100644 --- a/stdlib/source/library/lux/control/concurrency/atom.lux +++ b/stdlib/source/library/lux/control/concurrency/atom.lux @@ -93,7 +93,7 @@ #let [new (f old)] swapped? (..compare_and_swap old new atom)] (if swapped? - (wrap [old new]) + (in [old new]) (recur []))))) (def: #export (write value atom) diff --git a/stdlib/source/library/lux/control/concurrency/frp.lux b/stdlib/source/library/lux/control/concurrency/frp.lux index fee1a5dda..9bda3c334 100644 --- a/stdlib/source/library/lux/control/concurrency/frp.lux +++ b/stdlib/source/library/lux/control/concurrency/frp.lux @@ -44,13 +44,13 @@ stopped? (current #.None)] (if stopped? ## I closed the sink. - (wrap (exception.return [])) + (in (exception.return [])) ## Someone else interacted with the sink. (do ! [latter (atom.read sink)] (if (is? current latter) ## Someone else closed the sink. - (wrap (exception.throw ..channel_is_already_closed [])) + (in (exception.except ..channel_is_already_closed [])) ## Someone else fed the sink while I was closing it. (recur []))))))) @@ -70,13 +70,13 @@ ## I fed the sink. (do ! [_ (atom.compare_and_swap current resolve_next sink)] - (wrap (exception.return []))) + (in (exception.return []))) ## Someone else interacted with the sink. (do ! [latter (atom.read sink)] (if (is? current latter) ## Someone else closed the sink while I was feeding it. - (wrap (exception.throw ..channel_is_already_closed [])) + (in (exception.except ..channel_is_already_closed [])) ## Someone else fed the sink. (recur [])))))))))) @@ -106,10 +106,10 @@ cons_a fa] (case [cons_f cons_a] [(#.Some [head_f tail_f]) (#.Some [head_a tail_a])] - (wrap (#.Some [(head_f head_a) (apply tail_f tail_a)])) + (in (#.Some [(head_f head_a) (apply tail_f tail_a)])) _ - (wrap #.None))))) + (in #.None))))) (def: empty Channel @@ -120,7 +120,7 @@ (def: &functor ..functor) - (def: (wrap a) + (def: (in a) (async.resolved (#.Some [a ..empty]))) (def: (join mma) @@ -141,11 +141,11 @@ (recur ma')) #.None - (wrap []))))] + (in []))))] (recur mma')) #.None - (wrap (: Any (io.run (\ sink close)))))))) + (in (: Any (io.run (\ sink close)))))))) output)))) (type: #export (Subscriber a) @@ -165,10 +165,10 @@ (recur tail) #.None - (wrap [])) + (in [])) #.None - (wrap []))))) + (in []))))) []))) (def: #export (only pass? channel) @@ -181,11 +181,11 @@ (#.Some [head tail]) (let [tail' (only pass? tail)] (if (pass? head) - (wrap (#.Some [head tail'])) + (in (#.Some [head tail'])) tail')) #.None - (wrap #.None)))) + (in #.None)))) (def: #export (of_async async) {#.doc (doc "A one-element channel containing the output from an async.")} @@ -203,7 +203,7 @@ [cons channel] (case cons #.None - (wrap init) + (in init) (#.Some [head tail]) (do ! @@ -218,12 +218,12 @@ [cons channel] (case cons #.None - (wrap (#.Some [init (wrap #.None)])) + (in (#.Some [init (in #.None)])) (#.Some [head tail]) (do ! [init' (f head init)] - (wrap (#.Some [init (folds f init' tail)])))))) + (in (#.Some [init (folds f init' tail)])))))) (def: #export (poll milli_seconds action) (All [a] @@ -246,10 +246,10 @@ [?next (f init)] (case ?next (#.Some [state output]) - (wrap (#.Some [output (iterate f state)])) + (in (#.Some [output (iterate f state)])) #.None - (wrap #.None)))) + (in #.None)))) (def: (distinct' equivalence previous channel) (All [a] (-> (Equivalence a) a (Channel a) (Channel a))) @@ -259,10 +259,10 @@ (#.Some [head tail]) (if (\ equivalence = previous head) (distinct' equivalence previous tail) - (wrap (#.Some [head (distinct' equivalence head tail)]))) + (in (#.Some [head (distinct' equivalence head tail)]))) #.None - (wrap #.None)))) + (in #.None)))) (def: #export (distinct equivalence channel) (All [a] (-> (Equivalence a) (Channel a) (Channel a))) @@ -270,10 +270,10 @@ [cons channel] (case cons (#.Some [head tail]) - (wrap (#.Some [head (distinct' equivalence head tail)])) + (in (#.Some [head (distinct' equivalence head tail)])) #.None - (wrap #.None)))) + (in #.None)))) (def: #export (consume channel) (All [a] (-> (Channel a) (Async (List a)))) @@ -285,7 +285,7 @@ (consume tail)) #.None - (wrap #.Nil)))) + (in #.Nil)))) (def: #export (sequential milli_seconds values) {#.doc (doc "Transforms the given list into a channel with the same elements.")} diff --git a/stdlib/source/library/lux/control/concurrency/semaphore.lux b/stdlib/source/library/lux/control/concurrency/semaphore.lux index 56b70bbc1..fc6f939c8 100644 --- a/stdlib/source/library/lux/control/concurrency/semaphore.lux +++ b/stdlib/source/library/lux/control/concurrency/semaphore.lux @@ -61,7 +61,7 @@ [(update@ #waiting_list (queue.push sink))])) semaphore)] (with_expansions [<go_ahead> (sink []) - <get_in_line> (wrap false)] + <get_in_line> (in false)] (if (|> state' <had_open_position?>) <go_ahead> <get_in_line>))))) @@ -86,15 +86,15 @@ (update@ #waiting_list queue.pop)))) semaphore)] (if (is? pre post) - (wrap (exception.throw ..semaphore_is_maxed_out [(get@ #max_positions pre)])) + (in (exception.except ..semaphore_is_maxed_out [(get@ #max_positions pre)])) (do ! [_ (case (queue.peek (get@ #waiting_list pre)) #.None - (wrap true) + (in true) (#.Some sink) (sink []))] - (wrap (#try.Success (get@ #open_positions post))))))))) + (in (#try.Success (get@ #open_positions post))))))))) ) (abstract: #export Mutex @@ -122,7 +122,7 @@ [_ (..acquire mutex) output (io.run procedure) _ (..release mutex)] - (wrap output))) + (in output))) ) (def: #export limit @@ -155,7 +155,7 @@ (do async.monad [outcome (..signal turnstile)] (recur (inc step))) - (\ async.monad wrap [])))) + (\ async.monad in [])))) (template [<phase> <update> <goal> <turnstile>] [(def: (<phase> (^:representation barrier)) diff --git a/stdlib/source/library/lux/control/concurrency/stm.lux b/stdlib/source/library/lux/control/concurrency/stm.lux index 3f912c3de..da01d2db8 100644 --- a/stdlib/source/library/lux/control/concurrency/stm.lux +++ b/stdlib/source/library/lux/control/concurrency/stm.lux @@ -43,7 +43,7 @@ [_ (atom.update (function (_ [value observers]) [value (list.only (|>> (is? sink) not) observers)]) (:representation var))] - (wrap []))) + (in []))) (def: (write! new_value var) (All [a] (-> a (Var a) (IO Any))) @@ -58,12 +58,12 @@ [result (\ sink feed new_value)] (case result (#try.Success _) - (wrap []) + (in []) (#try.Failure _) (un_follow sink var)))) observers)] - (wrap [])) + (in [])) (write! new_value var)))) (def: #export (follow target) @@ -74,7 +74,7 @@ _ (atom.update (function (_ [value observers]) [value (#.Cons sink observers)]) (:representation target))] - (wrap [channel sink]))) + (in [channel sink]))) ) (type: (Tx_Frame a) @@ -89,7 +89,7 @@ {#.doc "A computation which updates a transaction and produces a value."} (-> Tx [Tx a])) -(def: (find_var_value var tx) +(def: (var_value var tx) (All [a] (-> (Var a) Tx (Maybe a))) (|> tx (list.find (function (_ [_var _original _current]) @@ -103,7 +103,7 @@ (def: #export (read var) (All [a] (-> (Var a) (STM a))) (function (_ tx) - (case (find_var_value var tx) + (case (var_value var tx) (#.Some value) [tx value] @@ -133,7 +133,7 @@ (def: #export (write value var) (All [a] (-> a (Var a) (STM Any))) (function (_ tx) - (case (find_var_value var tx) + (case (var_value var tx) (#.Some _) [(update_tx_value var value tx) []] @@ -166,7 +166,7 @@ (def: &functor ..functor) - (def: (wrap a) + (def: (in a) (function (_ tx) [tx a])) @@ -182,7 +182,7 @@ [a (..read var) #let [a' (f a)] _ (..write a' var)] - (wrap [a a']))) + (in [a a']))) (def: (can_commit? tx) (-> Tx Bit) @@ -247,7 +247,7 @@ (do {! io.monad} [flag (atom.read commit_processor_flag)] (if flag - (wrap []) + (in []) (do ! [was_first? (atom.compare_and_swap flag #1 commit_processor_flag)] (if was_first? @@ -258,7 +258,7 @@ [_ (process_commit head)] (async.await recur tail))) async)) - (wrap []))) + (in []))) ))) (def: #export (commit stm_proc) diff --git a/stdlib/source/library/lux/control/concurrency/thread.lux b/stdlib/source/library/lux/control/concurrency/thread.lux index 3d288f8a6..36f65d0ea 100644 --- a/stdlib/source/library/lux/control/concurrency/thread.lux +++ b/stdlib/source/library/lux/control/concurrency/thread.lux @@ -125,7 +125,7 @@ [(|> milli_seconds n.frac (f./ +1,000.0))] threading/Timer::new (threading/Timer::start []))] - (wrap []))} + (in []))} ## Default (do {! io.monad} @@ -134,7 +134,7 @@ #delay milli_seconds #action action})) ..runner)] - (wrap []))))) + (in []))))) (for {@.old (as_is) @.jvm (as_is) @@ -154,7 +154,7 @@ (case threads ## And... we're done! #.Nil - (wrap []) + (in []) _ (do ! diff --git a/stdlib/source/library/lux/control/continuation.lux b/stdlib/source/library/lux/control/continuation.lux index 8b9b5a24f..e36f3ba69 100644 --- a/stdlib/source/library/lux/control/continuation.lux +++ b/stdlib/source/library/lux/control/continuation.lux @@ -41,7 +41,7 @@ {#.doc (doc "Turns any expression into a function that is pending a continuation." (pending (some_function some_input)))} (with_gensyms [g!_ g!k] - (wrap (list (` (.function ((~ g!_) (~ g!k)) ((~ g!k) (~ expr)))))))) + (in (list (` (.function ((~ g!_) (~ g!k)) ((~ g!k) (~ expr)))))))) (def: #export (reset scope) (All [i o] (-> (Cont i i) (Cont i o))) @@ -79,7 +79,7 @@ (def: &functor ..functor) - (def: (wrap value) + (def: (in value) (function (_ k) (k value))) (def: (join ffa) @@ -97,4 +97,4 @@ [#let [nexus (function (nexus val) (k [nexus val]))] _ (k [nexus init])] - (wrap (undefined)))))) + (in (undefined)))))) diff --git a/stdlib/source/library/lux/control/exception.lux b/stdlib/source/library/lux/control/exception.lux index 6d8b4e5e7..22b882f85 100644 --- a/stdlib/source/library/lux/control/exception.lux +++ b/stdlib/source/library/lux/control/exception.lux @@ -1,4 +1,5 @@ -(.module: {#.doc "Exception-handling functionality."} +(.module: + {#.doc "Pure-Lux exception-handling functionality."} [library [lux #* ["." macro] @@ -76,7 +77,7 @@ (All [e] (-> (Exception e) e Text)) ((get@ #..constructor exception) message)) -(def: #export (throw exception message) +(def: #export (except exception message) {#.doc "Decorate an error message with an Exception and lift it into the error-handling context."} (All [e a] (-> (Exception e) e (Try a))) (#//.Failure (..construct exception message))) @@ -85,11 +86,11 @@ (All [e] (-> (Exception e) e Bit (Try Any))) (if test (#//.Success []) - (..throw exception message))) + (..except exception message))) (syntax: #export (exception: {export |export|.parser} {t_vars (p.default (list) (s.tuple (p.some |type_variable|.parser)))} - {[name inputs] (p.either (p.and s.local_identifier (wrap (list))) + {[name inputs] (p.either (p.and s.local_identifier (in (list))) (s.form (p.and s.local_identifier (p.some |input|.parser))))} {body (p.maybe s.any)}) {#.doc (doc "Define a new exception type." @@ -106,15 +107,15 @@ [current_module meta.current_module_name #let [descriptor ($_ text\compose "{" current_module "." name "}" text.new_line) g!self (code.local_identifier name)]] - (wrap (list (` (def: (~+ (|export|.format export)) - (~ g!self) - (All [(~+ (list\map |type_variable|.format t_vars))] - (..Exception [(~+ (list\map (get@ #|input|.type) inputs))])) - (let [(~ g!descriptor) (~ (code.text descriptor))] - {#..label (~ g!descriptor) - #..constructor (function ((~ g!self) [(~+ (list\map (get@ #|input|.binding) inputs))]) - ((~! text\compose) (~ g!descriptor) - (~ (maybe.default (' "") body))))}))))) + (in (list (` (def: (~+ (|export|.format export)) + (~ g!self) + (All [(~+ (list\map |type_variable|.format t_vars))] + (..Exception [(~+ (list\map (get@ #|input|.type) inputs))])) + (let [(~ g!descriptor) (~ (code.text descriptor))] + {#..label (~ g!descriptor) + #..constructor (function ((~ g!self) [(~+ (list\map (get@ #|input|.binding) inputs))]) + ((~! text\compose) (~ g!descriptor) + (~ (maybe.default (' "") body))))}))))) ))) (def: (report' entries) @@ -149,9 +150,9 @@ tail)))) (syntax: #export (report {entries (p.many (s.tuple (p.and s.any s.any)))}) - (wrap (list (` ((~! report') (list (~+ (|> entries - (list\map (function (_ [header message]) - (` [(~ header) (~ message)]))))))))))) + (in (list (` ((~! report') (list (~+ (|> entries + (list\map (function (_ [header message]) + (` [(~ header) (~ message)]))))))))))) (def: #export (enumerate format entries) (All [a] diff --git a/stdlib/source/library/lux/control/function/contract.lux b/stdlib/source/library/lux/control/function/contract.lux index 414445ac1..00c1bb59c 100644 --- a/stdlib/source/library/lux/control/function/contract.lux +++ b/stdlib/source/library/lux/control/function/contract.lux @@ -34,10 +34,10 @@ "Otherwise, an error is raised." (pre (i.= +4 (i.+ +2 +2)) (foo +123 +456 +789)))} - (wrap (list (` (exec - ((~! ..assert!) (~ (code.text (exception.construct ..pre_condition_failed test))) - (~ test)) - (~ expr)))))) + (in (list (` (exec + ((~! ..assert!) (~ (code.text (exception.construct ..pre_condition_failed test))) + (~ test)) + (~ expr)))))) (syntax: #export (post test expr) {#.doc (doc "Post-conditions." @@ -47,8 +47,8 @@ (post i.even? (i.+ +2 +2)))} (with_gensyms [g!output] - (wrap (list (` (let [(~ g!output) (~ expr)] - (exec - ((~! ..assert!) (~ (code.text (exception.construct ..post_condition_failed test))) - ((~ test) (~ g!output))) - (~ g!output)))))))) + (in (list (` (let [(~ g!output) (~ expr)] + (exec + ((~! ..assert!) (~ (code.text (exception.construct ..post_condition_failed test))) + ((~ test) (~ g!output))) + (~ g!output)))))))) diff --git a/stdlib/source/library/lux/control/function/memo.lux b/stdlib/source/library/lux/control/function/memo.lux index e2b734cae..da293b1f6 100644 --- a/stdlib/source/library/lux/control/function/memo.lux +++ b/stdlib/source/library/lux/control/function/memo.lux @@ -25,13 +25,13 @@ [memory state.get] (case (dictionary.get input memory) (#.Some output) - (wrap output) + (in output) #.None (do ! [output (delegate input) _ (state.update (dictionary.put input output))] - (wrap output))))))) + (in output))))))) (type: #export (Memo i o) (Recursive i (State (Dictionary i o) o))) diff --git a/stdlib/source/library/lux/control/function/mixin.lux b/stdlib/source/library/lux/control/function/mixin.lux index 8248b2055..796c04057 100644 --- a/stdlib/source/library/lux/control/function/mixin.lux +++ b/stdlib/source/library/lux/control/function/mixin.lux @@ -60,7 +60,7 @@ (do monad [output (delegate input) _ (action input output)] - (wrap output)))) + (in output)))) (type: #export (Recursive i o) {#.doc (doc "An indirectly recursive function.")} diff --git a/stdlib/source/library/lux/control/function/mutual.lux b/stdlib/source/library/lux/control/function/mutual.lux index 97d2c3ac1..73407a7f1 100644 --- a/stdlib/source/library/lux/control/function/mutual.lux +++ b/stdlib/source/library/lux/control/function/mutual.lux @@ -51,7 +51,7 @@ (<| (:as Macro) (: Macro') (function (_ parameters) - (\ meta.monad wrap (list (` (((~ g!self) (~ g!context)) (~+ parameters)))))))) + (\ meta.monad in (list (` (((~ g!self) (~ g!context)) (~+ parameters)))))))) (syntax: #export (let {functions (<code>.tuple (<>.some ..mutual))} body) @@ -71,14 +71,14 @@ (odd? 5))))} (case functions #.Nil - (wrap (list body)) + (in (list body)) (#.Cons mutual #.Nil) (.let [g!name (|> mutual (get@ [#declaration #declaration.name]) code.local_identifier)] - (wrap (list (` (.let [(~ g!name) (: (~ (get@ #type mutual)) - (function (~ (declaration.format (get@ #declaration mutual))) - (~ (get@ #body mutual))))] - (~ body)))))) + (in (list (` (.let [(~ g!name) (: (~ (get@ #type mutual)) + (function (~ (declaration.format (get@ #declaration mutual))) + (~ (get@ #body mutual))))] + (~ body)))))) _ (macro.with_gensyms [g!context g!output] @@ -99,16 +99,16 @@ (..macro g!context g!name)]) (list.zipped/2 hidden_names functions)))] - (wrap (list (` (.let [(~ g!context) (: (Rec (~ g!context) - [(~+ context_types)]) - [(~+ definitions)]) - [(~+ user_names)] (.let [[(~+ user_names)] (~ g!context)] - [(~+ (list\map (function (_ g!name) - (` ((~ g!name) (~ g!context)))) - user_names))]) - (~ g!output) (~ body)] - (exec (~ g!pop) - (~ g!output)))))))))) + (in (list (` (.let [(~ g!context) (: (Rec (~ g!context) + [(~+ context_types)]) + [(~+ definitions)]) + [(~+ user_names)] (.let [[(~+ user_names)] (~ g!context)] + [(~+ (list\map (function (_ g!name) + (` ((~ g!name) (~ g!context)))) + user_names))]) + (~ g!output) (~ body)] + (exec (~ g!pop) + (~ g!output)))))))))) (type: Definition {#exported? Bit @@ -135,16 +135,16 @@ _ (even? (dec number)))]))} (case functions #.Nil - (wrap (list)) + (in (list)) (#.Cons definition #.Nil) (.let [(^slots [#exported? #mutual]) definition (^slots [#declaration #type #body]) mutual] - (wrap (list (` (.def: - (~+ (export.format exported?)) - (~ (declaration.format declaration)) - (~ type) - (~ body)))))) + (in (list (` (.def: + (~+ (export.format exported?)) + (~ (declaration.format declaration)) + (~ type) + (~ body)))))) _ (macro.with_gensyms [g!context g!output] @@ -165,22 +165,22 @@ (..macro g!context g!name)]) (list.zipped/2 hidden_names functions)))] - (wrap (list& (` (.def: (~ g!context) - [(~+ (list\map (get@ [#mutual #type]) functions))] - (.let [(~ g!context) (: (Rec (~ g!context) - [(~+ context_types)]) - [(~+ definitions)]) - [(~+ user_names)] (~ g!context)] - [(~+ (list\map (function (_ g!name) - (` ((~ g!name) (~ g!context)))) - user_names))]))) - g!pop - (list\map (function (_ mutual) - (.let [g!name (|> mutual (get@ [#mutual #declaration #declaration.name]) code.local_identifier)] - (` (.def: - (~+ (export.format (get@ #exported? mutual))) - (~ g!name) - (~ (get@ [#mutual #type] mutual)) - (.let [[(~+ user_names)] (~ g!context)] - (~ g!name)))))) - functions))))))) + (in (list& (` (.def: (~ g!context) + [(~+ (list\map (get@ [#mutual #type]) functions))] + (.let [(~ g!context) (: (Rec (~ g!context) + [(~+ context_types)]) + [(~+ definitions)]) + [(~+ user_names)] (~ g!context)] + [(~+ (list\map (function (_ g!name) + (` ((~ g!name) (~ g!context)))) + user_names))]))) + g!pop + (list\map (function (_ mutual) + (.let [g!name (|> mutual (get@ [#mutual #declaration #declaration.name]) code.local_identifier)] + (` (.def: + (~+ (export.format (get@ #exported? mutual))) + (~ g!name) + (~ (get@ [#mutual #type] mutual)) + (.let [[(~+ user_names)] (~ g!context)] + (~ g!name)))))) + functions))))))) diff --git a/stdlib/source/library/lux/control/io.lux b/stdlib/source/library/lux/control/io.lux index a4773cd0d..b3d5893bd 100644 --- a/stdlib/source/library/lux/control/io.lux +++ b/stdlib/source/library/lux/control/io.lux @@ -1,4 +1,5 @@ -(.module: {#.doc "A method for abstracting I/O and effectful computations to make it safe while writing pure functional code."} +(.module: + {#.doc "A method for abstracting I/O and effectful computations to make it safe while writing pure functional code."} [library [lux #* [abstract @@ -39,8 +40,8 @@ (log! msg) "Some value...")))} (with_gensyms [g!func g!arg] - (wrap (list (` ((~! ..label) (function ((~ g!func) (~ g!arg)) - (~ computation)))))))) + (in (list (` ((~! ..label) (function ((~ g!func) (~ g!arg)) + (~ computation)))))))) (def: #export run {#.doc "A way to execute IO computations and perform their side-effects."} @@ -66,7 +67,7 @@ (def: &functor ..functor) - (def: wrap (|>> !io)) + (def: in (|>> !io)) (def: join (|>> !run !run !io))) ) diff --git a/stdlib/source/library/lux/control/parser.lux b/stdlib/source/library/lux/control/parser.lux index d017e9dd4..f473208a9 100644 --- a/stdlib/source/library/lux/control/parser.lux +++ b/stdlib/source/library/lux/control/parser.lux @@ -56,7 +56,7 @@ (def: &functor ..functor) - (def: (wrap x) + (def: (in x) (function (_ input) (#try.Success [input x]))) @@ -157,7 +157,7 @@ {#.doc "Parse exactly N times."} (All [s a] (-> Nat (Parser s a) (Parser s (List a)))) (case amount - 0 (\ ..monad wrap (list)) + 0 (\ ..monad in (list)) _ (do {! ..monad} [x parser] (|> parser @@ -175,7 +175,7 @@ {#.doc "Parse at most N times."} (All [s a] (-> Nat (Parser s a) (Parser s (List a)))) (case amount - 0 (\ ..monad wrap (list)) + 0 (\ ..monad in (list)) _ (function (_ input) (case (parser input) (#try.Failure msg) @@ -194,7 +194,7 @@ (if (n.< to from) (\ ! map (list\compose minimum) (..at_most (n.- from to) parser)) - (wrap minimum)))) + (in minimum)))) (def: #export (separated_by separator parser) {#.doc "Parsers instances of 'parser' that are separated by instances of 'separator'."} @@ -203,7 +203,7 @@ [?x (..maybe parser)] (case ?x #.None - (wrap #.Nil) + (in #.Nil) (#.Some x) (|> parser @@ -269,14 +269,14 @@ (do ..monad [output subject _ param] - (wrap output))) + (in output))) (def: #export (only test parser) (All [s a] (-> (-> a Bit) (Parser s a) (Parser s a))) (do ..monad [output parser _ (..assert "Constraint failed." (test output))] - (wrap output))) + (in output))) (def: #export (parses? parser) (All [s a] (-> (Parser s a) (Parser s Bit))) diff --git a/stdlib/source/library/lux/control/parser/analysis.lux b/stdlib/source/library/lux/control/parser/analysis.lux index df8d140ab..2b585c31e 100644 --- a/stdlib/source/library/lux/control/parser/analysis.lux +++ b/stdlib/source/library/lux/control/parser/analysis.lux @@ -63,7 +63,7 @@ (#try.Success value) (#try.Success [unconsumed _]) - (exception.throw ..unconsumed_input unconsumed))) + (exception.except ..unconsumed_input unconsumed))) (def: #export any {#.doc (doc "Matches any value, without discrimination.")} @@ -71,7 +71,7 @@ (function (_ input) (case input #.Nil - (exception.throw ..cannot_parse input) + (exception.except ..cannot_parse input) (#.Cons [head tail]) (#try.Success [tail head])))) @@ -103,7 +103,7 @@ (#try.Success [input' x]) _ - (exception.throw ..cannot_parse input)))) + (exception.except ..cannot_parse input)))) (def: #export (<assertion> expected) {#.doc (doc (~~ (template.text ["Assert a specific " <query> " value."])))} @@ -113,10 +113,10 @@ (^ (list& (<tag> actual) input')) (if (\ <eq> = expected actual) (#try.Success [input' []]) - (exception.throw ..cannot_parse input)) + (exception.except ..cannot_parse input)) _ - (exception.throw ..cannot_parse input))))))] + (exception.except ..cannot_parse input))))))] [bit bit! /.bit Bit bit.equivalence] [nat nat! /.nat Nat nat.equivalence] @@ -140,4 +140,4 @@ (#try.Success [tail output])) _ - (exception.throw ..cannot_parse input)))) + (exception.except ..cannot_parse input)))) diff --git a/stdlib/source/library/lux/control/parser/binary.lux b/stdlib/source/library/lux/control/parser/binary.lux index f7a2cb94a..6543cb954 100644 --- a/stdlib/source/library/lux/control/parser/binary.lux +++ b/stdlib/source/library/lux/control/parser/binary.lux @@ -50,7 +50,7 @@ (let [length (/.size input)] (if (n.= end length) (#try.Success output) - (exception.throw ..binary_was_not_fully_read [length end]))))) + (exception.except ..binary_was_not_fully_read [length end]))))) (def: #export end? {#.doc (doc "Checks whether there is no more data to read.")} @@ -121,7 +121,7 @@ (^template [<number> <tag> <parser>] [<number> (\ ! map (|>> <tag>) <parser>)]) ((~~ (template.spliced <case>+))) - _ (//.lift (exception.throw ..invalid_tag [(~~ (template.amount <case>+)) flag])))))) + _ (//.lift (exception.except ..invalid_tag [(~~ (template.amount <case>+)) flag])))))) (def: #export (or left right) (All [l r] (-> (Parser l) (Parser r) (Parser (| l r)))) @@ -138,7 +138,7 @@ (def: #export any {#.doc (doc "Does no parsing, and just returns a dummy value.")} (Parser Any) - (//\wrap [])) + (//\in [])) (exception: #export (not_a_bit {value Nat}) (exception.report @@ -151,9 +151,9 @@ [value (: (Parser Nat) ..bits/8)] (case value - 0 (wrap #0) - 1 (wrap #1) - _ (//.lift (exception.throw ..not_a_bit [value]))))) + 0 (in #0) + 1 (in #1) + _ (//.lift (exception.except ..not_a_bit [value]))))) (def: #export (segment size) {#.doc (doc "Parses a chunk of data of a given size.")} @@ -214,7 +214,7 @@ [value valueP] (recur (.inc index) (row.add value output))) - (//\wrap output)))))] + (//\in output)))))] [08 row/8 ..bits/8] [16 row/16 ..bits/16] @@ -243,7 +243,7 @@ _ (//.assert (exception.construct ..set_elements_are_not_unique []) (n.= (list.size raw) (set.size output)))] - (wrap output))) + (in output))) (def: #export name (Parser Name) diff --git a/stdlib/source/library/lux/control/parser/cli.lux b/stdlib/source/library/lux/control/parser/cli.lux index 5a66208b4..e8796ff1b 100644 --- a/stdlib/source/library/lux/control/parser/cli.lux +++ b/stdlib/source/library/lux/control/parser/cli.lux @@ -47,7 +47,7 @@ (do try.monad [[remaining raw] (any inputs) output (parser raw)] - (wrap [remaining output])))) + (in [remaining output])))) (def: #export (this reference) {#.doc "Checks that a token is in the inputs."} @@ -56,7 +56,7 @@ (do try.monad [[remaining raw] (any inputs)] (if (text\= reference raw) - (wrap [remaining []]) + (in [remaining []]) (#try.Failure (format "Missing token: '" reference "'")))))) (def: #export (somewhere cli) @@ -76,8 +76,8 @@ (#.Cons to_omit immediate') (do try.monad [[remaining output] (recur immediate')] - (wrap [(#.Cons to_omit remaining) - output]))))))) + (in [(#.Cons to_omit remaining) + output]))))))) (def: #export end {#.doc "Ensures there are no more inputs."} diff --git a/stdlib/source/library/lux/control/parser/code.lux b/stdlib/source/library/lux/control/parser/code.lux index bb37c1faf..6f52b23d9 100644 --- a/stdlib/source/library/lux/control/parser/code.lux +++ b/stdlib/source/library/lux/control/parser/code.lux @@ -28,16 +28,16 @@ (#.Cons [[x y] pairs']) (list& x y (join_pairs pairs')))) (type: #export Parser - {#.doc "A Lux syntax parser."} + {#.doc "A Lux code parser."} (//.Parser (List Code))) -(def: (remaining_inputs asts) +(def: (remaining_inputs codes) (-> (List Code) Text) ($_ text\compose text.new_line "Remaining input: " - (|> asts (list\map code.format) (list.interpose " ") (text.join_with "")))) + (|> codes (list\map code.format) (list.interpose " ") (text.join_with "")))) (def: #export any - {#.doc "Just returns the next input without applying any logic."} + {#.doc "Yields the next input without applying any logic."} (Parser Code) (function (_ tokens) (case tokens @@ -61,6 +61,7 @@ <failure>))) (def: #export (<check> expected) + {#.doc (code.text ($_ text\compose "Checks for a specific " <desc> " input."))} (-> <type> (Parser Any)) (function (_ tokens) (case tokens @@ -82,15 +83,15 @@ [tag tag! Name #.Tag name.equivalence "tag"] ) -(def: #export (this! ast) +(def: #export (this! code) {#.doc "Ensures the given Code is the next input."} (-> Code (Parser Any)) (function (_ tokens) (case tokens (#.Cons [token tokens']) - (if (code\= ast token) + (if (code\= code token) (#try.Success [tokens' []]) - (#try.Failure ($_ text\compose "Expected a " (code.format ast) " but instead got " (code.format token) + (#try.Failure ($_ text\compose "Expected a " (code.format code) " but instead got " (code.format token) (remaining_inputs tokens)))) _ @@ -110,6 +111,7 @@ <failure>))) (def: #export (<check> expected) + {#.doc (code.text ($_ text\compose "Checks for a specific local " <desc> " (a " <desc> " that has no module prefix)."))} (-> Text (Parser Any)) (function (_ tokens) (case tokens @@ -127,7 +129,7 @@ (template [<name> <tag> <desc>] [(def: #export (<name> p) - {#.doc (code.text ($_ text\compose "Parse inside the contents of a " <desc> " as if they were the input Codes."))} + {#.doc (code.text ($_ text\compose "Parses the contents of a " <desc> "."))} (All [a] (-> (Parser a) (Parser a))) (function (_ tokens) @@ -145,7 +147,7 @@ ) (def: #export (record p) - {#.doc (code.text ($_ text\compose "Parse inside the contents of a record as if they were the input Codes."))} + {#.doc "Parses the contents of a record."} (All [a] (-> (Parser a) (Parser a))) (function (_ tokens) @@ -159,7 +161,7 @@ (#try.Failure ($_ text\compose "Cannot parse record" (remaining_inputs tokens)))))) (def: #export end! - {#.doc "Ensures there are no more inputs."} + {#.doc "Verifies there are no more inputs."} (Parser Any) (function (_ tokens) (case tokens @@ -174,9 +176,10 @@ #.Nil true _ false)]))) -(def: #export (run syntax inputs) +(def: #export (run parser inputs) + {#.doc (doc "Executes a parser against a stream of code, and verifies all the inputs are consumed.")} (All [a] (-> (Parser a) (List Code) (Try a))) - (case (syntax inputs) + (case (parser inputs) (#try.Failure error) (#try.Failure error) @@ -190,10 +193,10 @@ (|> (list\map code.format unconsumed) (text.join_with ", "))))))) -(def: #export (local inputs syntax) - {#.doc "Run a syntax parser with the given list of inputs, instead of the real ones."} +(def: #export (local inputs parser) + {#.doc "Runs parser against the given list of inputs."} (All [a] (-> (List Code) (Parser a) (Parser a))) (function (_ real) (do try.monad - [value (..run syntax inputs)] - (wrap [real value])))) + [value (..run parser inputs)] + (in [real value])))) diff --git a/stdlib/source/library/lux/control/parser/environment.lux b/stdlib/source/library/lux/control/parser/environment.lux index c0ced37c2..ea3370c0a 100644 --- a/stdlib/source/library/lux/control/parser/environment.lux +++ b/stdlib/source/library/lux/control/parser/environment.lux @@ -13,32 +13,38 @@ ["." //]) (type: #export Property + {#.doc (doc "A property in the environment.")} Text) (type: #export Environment + {#.doc (doc "An abstraction for environment variables of a program.")} (Dictionary Property Text)) -(exception: #export (unknown {property Property}) +(exception: #export (unknown_property {property Property}) (exception.report ["Property" (%.text property)])) (type: #export (Parser a) + {#.doc (doc "A parser of environment variables of a program.")} (//.Parser Environment a)) (def: #export empty + {#.doc (doc "An empty environment.")} Environment (dictionary.new text.hash)) (def: #export (property name) - (-> Text (Parser Text)) + (-> Property (Parser Text)) (function (_ environment) (case (dictionary.get name environment) (#.Some value) (exception.return [environment value]) #.None - (exception.throw ..unknown name)))) + (exception.except ..unknown_property [name])))) (def: #export (run parser environment) + {#.doc (doc "Executes a parser against the given environment variables." + "Does not check whether all environment variables were parsed, since they're usually an open set.")} (All [a] (-> (Parser a) Environment (Try a))) (\ try.monad map product.right (parser environment))) diff --git a/stdlib/source/library/lux/control/parser/json.lux b/stdlib/source/library/lux/control/parser/json.lux index 2e9935480..cc20f6512 100644 --- a/stdlib/source/library/lux/control/parser/json.lux +++ b/stdlib/source/library/lux/control/parser/json.lux @@ -23,7 +23,7 @@ ["." // ("#\." functor)]) (type: #export (Parser a) - {#.doc "JSON parser."} + {#.doc "A JSON parser."} (//.Parser (List JSON) a)) (exception: #export (unconsumed_input {input (List JSON)}) @@ -33,6 +33,8 @@ (exception: #export empty_input) (def: #export (run parser json) + {#.doc (doc "Executes the parser against a JSON object." + "Verifies that all of the JSON was consumed by the parser.")} (All [a] (-> (Parser a) JSON (Try a))) (case (//.run parser (list json)) (#try.Success [remainder output]) @@ -41,7 +43,7 @@ (#try.Success output) _ - (exception.throw ..unconsumed_input remainder)) + (exception.except ..unconsumed_input remainder)) (#try.Failure error) (#try.Failure error))) @@ -52,7 +54,7 @@ (<| (function (_ inputs)) (case inputs #.Nil - (exception.throw ..empty_input []) + (exception.except ..empty_input []) (#.Cons head tail) (#try.Success [tail head])))) @@ -69,7 +71,7 @@ [head ..any] (case head (<tag> value) - (wrap value) + (in value) _ (//.failure (exception.construct ..unexpected_value [head])))))] @@ -93,7 +95,7 @@ [head ..any] (case head (<tag> value) - (wrap (\ <equivalence> = test value)) + (in (\ <equivalence> = test value)) _ (//.failure (exception.construct ..unexpected_value [head]))))) @@ -106,7 +108,7 @@ (case head (<tag> value) (if (\ <equivalence> = test value) - (wrap []) + (in []) (//.failure (exception.construct ..value_mismatch [(<tag> test) (<tag> value)]))) _ @@ -118,12 +120,13 @@ ) (def: #export (nullable parser) + {#.doc (doc "Enhances parser by adding NULL-handling.")} (All [a] (-> (Parser a) (Parser (Maybe a)))) (//.or ..null parser)) (def: #export (array parser) - {#.doc "Parses a JSON array."} + {#.doc "Parses the contents of a JSON array."} (All [a] (-> (Parser a) (Parser a))) (do //.monad [head ..any] @@ -136,7 +139,7 @@ (#try.Success [remainder output]) (case remainder #.Nil - (wrap output) + (in output) _ (//.failure (exception.construct ..unconsumed_input remainder)))) @@ -145,7 +148,8 @@ (//.failure (exception.construct ..unexpected_value [head]))))) (def: #export (object parser) - {#.doc "Parses a JSON object. Use this with the 'field' combinator."} + {#.doc (doc "Parses the contents of a JSON object." + "Use this with the 'field' combinator.")} (All [a] (-> (Parser a) (Parser a))) (do //.monad [head ..any] @@ -163,7 +167,7 @@ (#try.Success [remainder output]) (case remainder #.Nil - (wrap output) + (in output) _ (//.failure (exception.construct ..unconsumed_input remainder)))) @@ -172,7 +176,8 @@ (//.failure (exception.construct ..unexpected_value [head]))))) (def: #export (field field_name parser) - {#.doc "Parses a field inside a JSON object. Use this inside the 'object' combinator."} + {#.doc (doc "Parses a field inside a JSON object." + "Use this inside the 'object' combinator.")} (All [a] (-> Text (Parser a) (Parser a))) (function (recur inputs) (case inputs @@ -183,20 +188,20 @@ (#try.Success [inputs' output]) (#try.Success [inputs'' _]) - (exception.throw ..unconsumed_input inputs'') + (exception.except ..unconsumed_input inputs'') (#try.Failure error) (#try.Failure error)) (do try.monad [[inputs'' output] (recur inputs')] - (wrap [(list& (#/.String key) value inputs'') - output]))) + (in [(list& (#/.String key) value inputs'') + output]))) #.Nil - (exception.throw ..empty_input []) + (exception.except ..empty_input []) _ - (exception.throw ..unconsumed_input inputs)))) + (exception.except ..unconsumed_input inputs)))) (def: #export dictionary {#.doc "Parses a dictionary-like JSON object."} diff --git a/stdlib/source/library/lux/control/parser/synthesis.lux b/stdlib/source/library/lux/control/parser/synthesis.lux index 9c8f76143..3496fde42 100644 --- a/stdlib/source/library/lux/control/parser/synthesis.lux +++ b/stdlib/source/library/lux/control/parser/synthesis.lux @@ -11,6 +11,8 @@ ["." name] ["." text ["%" format (#+ format)]]] + [macro + ["." template]] [math [number ["n" nat] @@ -27,20 +29,15 @@ ["/" synthesis (#+ Synthesis Abstraction)]]]]]]] ["." //]) -## TODO: Use "type:" ASAP. -(def: Input - Type - (type (List Synthesis))) - -(exception: #export (cannot_parse {input ..Input}) +(exception: #export (cannot_parse {input (List Synthesis)}) (exception.report ["Input" (exception.enumerate /.%synthesis input)])) -(exception: #export (unconsumed_input {input ..Input}) +(exception: #export (unconsumed_input {input (List Synthesis)}) (exception.report ["Input" (exception.enumerate /.%synthesis input)])) -(exception: #export (expected_empty_input {input ..Input}) +(exception: #export (expected_empty_input {input (List Synthesis)}) (exception.report ["Input" (exception.enumerate /.%synthesis input)])) @@ -52,10 +49,13 @@ (exception: #export empty_input) (type: #export Parser - (//.Parser ..Input)) + {#.doc (doc "A parser for the Lux compiler's synthesis nodes using during optimization.")} + (//.Parser (List Synthesis))) (def: #export (run parser input) - (All [a] (-> (Parser a) ..Input (Try a))) + {#.doc (doc "Executes the parser against the inputs." + "Ensures all inputs are consumed by the parser.")} + (All [a] (-> (Parser a) (List Synthesis) (Try a))) (case (parser input) (#try.Failure error) (#try.Failure error) @@ -64,14 +64,15 @@ (#try.Success value) (#try.Success [unconsumed _]) - (exception.throw ..unconsumed_input unconsumed))) + (exception.except ..unconsumed_input unconsumed))) (def: #export any + {#.doc (doc "Yields a synthesis node without subjecting it to any analysis.")} (Parser Synthesis) (.function (_ input) (case input #.Nil - (exception.throw ..empty_input []) + (exception.except ..empty_input []) (#.Cons [head tail]) (#try.Success [tail head])))) @@ -82,7 +83,7 @@ (.function (_ tokens) (case tokens #.Nil (#try.Success [tokens []]) - _ (exception.throw ..expected_empty_input [tokens])))) + _ (exception.except ..expected_empty_input [tokens])))) (def: #export end? {#.doc "Checks whether there are no more inputs."} @@ -93,27 +94,29 @@ _ false)]))) (template [<query> <assertion> <tag> <type> <eq>] - [(def: #export <query> - (Parser <type>) - (.function (_ input) - (case input - (^ (list& (<tag> x) input')) - (#try.Success [input' x]) - - _ - (exception.throw ..cannot_parse input)))) - - (def: #export (<assertion> expected) - (-> <type> (Parser Any)) - (.function (_ input) - (case input - (^ (list& (<tag> actual) input')) - (if (\ <eq> = expected actual) - (#try.Success [input' []]) - (exception.throw ..cannot_parse input)) - - _ - (exception.throw ..cannot_parse input))))] + [(`` (def: #export <query> + {#.doc (doc (~~ (template.text ["Queries for a " <query> " synthesis node."])))} + (Parser <type>) + (.function (_ input) + (case input + (^ (list& (<tag> x) input')) + (#try.Success [input' x]) + + _ + (exception.except ..cannot_parse input))))) + + (`` (def: #export (<assertion> expected) + {#.doc (doc (~~ (template.text ["Checks for a specific " <query> " synthesis node."])))} + (-> <type> (Parser Any)) + (.function (_ input) + (case input + (^ (list& (<tag> actual) input')) + (if (\ <eq> = expected actual) + (#try.Success [input' []]) + (exception.except ..cannot_parse input)) + + _ + (exception.except ..cannot_parse input)))))] [bit bit! /.bit Bit bit.equivalence] [i64 i64! /.i64 (I64 Any) i64.equivalence] @@ -125,6 +128,7 @@ ) (def: #export (tuple parser) + {#.doc (doc "Parses the contents of a tuple.")} (All [a] (-> (Parser a) (Parser a))) (.function (_ input) (case input @@ -134,9 +138,10 @@ (#try.Success [tail output])) _ - (exception.throw ..cannot_parse input)))) + (exception.except ..cannot_parse input)))) (def: #export (function expected parser) + {#.doc (doc "Parses the body of a function with the 'expected' arity.")} (All [a] (-> Arity (Parser a) (Parser [(Environment Synthesis) a]))) (.function (_ input) (case input @@ -145,12 +150,13 @@ (do try.monad [output (..run parser (list body))] (#try.Success [tail [environment output]])) - (exception.throw ..wrong_arity [expected actual])) + (exception.except ..wrong_arity [expected actual])) _ - (exception.throw ..cannot_parse input)))) + (exception.except ..cannot_parse input)))) (def: #export (loop init_parsers iteration_parser) + {#.doc (doc "Parses the initial values and the body of a loop.")} (All [a b] (-> (Parser a) (Parser b) (Parser [Register a b]))) (.function (_ input) (case input @@ -161,4 +167,4 @@ (#try.Success [tail [start inits iteration]])) _ - (exception.throw ..cannot_parse input)))) + (exception.except ..cannot_parse input)))) diff --git a/stdlib/source/library/lux/control/parser/text.lux b/stdlib/source/library/lux/control/parser/text.lux index 6d4998419..aa4858f66 100644 --- a/stdlib/source/library/lux/control/parser/text.lux +++ b/stdlib/source/library/lux/control/parser/text.lux @@ -13,24 +13,31 @@ [collection ["." list ("#\." fold)]]] [macro - ["." code]] + ["." code] + ["." template]] [math [number ["n" nat ("#\." decimal)]]]]] ["." //]) -(type: #export Offset Nat) +(type: #export Offset + {#.doc (doc "An offset into a block of text.")} + Nat) -(def: start_offset Offset 0) +(def: start_offset + Offset + 0) (type: #export Parser + {#.doc (doc "A parser for text.")} (//.Parser [Offset Text])) (type: #export Slice + {#.doc (doc "A slice of a block of text.")} {#basis Offset #distance Offset}) -(def: (remaining offset tape) +(def: (remaining' offset tape) (-> Offset Text Text) (|> tape (/.split offset) maybe.assume product.right)) @@ -38,17 +45,19 @@ (exception.report ["Offset" (n\encode offset)] ["Input size" (n\encode (/.size tape))] - ["Remaining input" (remaining offset tape)])) + ["Remaining input" (remaining' offset tape)])) (exception: #export (expected_to_fail {offset Offset} {tape Text}) (exception.report ["Offset" (n\encode offset)] - ["Input" (remaining offset tape)])) + ["Input" (remaining' offset tape)])) (exception: #export cannot_parse) (exception: #export cannot_slice) (def: #export (run parser input) + {#.doc (doc "Executes a parser against a block of text." + "Verifies that the entire input has been processed.")} (All [a] (-> (Parser a) Text (Try a))) (case (parser [start_offset input]) (#try.Failure msg) @@ -57,9 +66,10 @@ (#try.Success [[end_offset _] output]) (if (n.= end_offset (/.size input)) (#try.Success output) - (exception.throw ..unconsumed_input [end_offset input])))) + (exception.except ..unconsumed_input [end_offset input])))) (def: #export offset + {#.doc (doc "Yields the current offset into the input.")} (Parser Offset) (function (_ (^@ input [offset tape])) (#try.Success [input offset]))) @@ -69,15 +79,15 @@ (do //.monad [offset ..offset slices parser] - (wrap (list\fold (function (_ [slice::basis slice::distance] - [total::basis total::distance]) - [total::basis ("lux i64 +" slice::distance total::distance)]) - {#basis offset - #distance 0} - slices)))) + (in (list\fold (function (_ [slice::basis slice::distance] + [total::basis total::distance]) + [total::basis ("lux i64 +" slice::distance total::distance)]) + {#basis offset + #distance 0} + slices)))) (def: #export any - {#.doc "Just returns the next character without applying any logic."} + {#.doc "Yields the next character without applying any logic."} (Parser Text) (function (_ [offset tape]) (case (/.nth offset tape) @@ -85,10 +95,10 @@ (#try.Success [[("lux i64 +" 1 offset) tape] (/.of_code output)]) _ - (exception.throw ..cannot_parse [])))) + (exception.except ..cannot_parse [])))) (def: #export any! - {#.doc "Just returns the next character without applying any logic."} + {#.doc "Yields the next character (as a slice) without applying any logic."} (Parser Slice) (function (_ [offset tape]) (case (/.nth offset tape) @@ -98,22 +108,22 @@ #distance 1}]) _ - (exception.throw ..cannot_slice [])))) - -(template [<name> <type> <any>] - [(def: #export (<name> p) - {#.doc "Produce a character if the parser fails."} - (All [a] (-> (Parser a) (Parser <type>))) - (function (_ input) - (case (p input) - (#try.Failure msg) - (<any> input) - - _ - (exception.throw ..expected_to_fail input))))] - - [not Text ..any] - [not! Slice ..any!] + (exception.except ..cannot_slice [])))) + +(template [<name> <type> <any> <caveat>] + [(`` (def: #export (<name> parser) + {#.doc (doc (~~ (template.text ["Produce a character" <caveat> " if the parser fails."])))} + (All [a] (-> (Parser a) (Parser <type>))) + (function (_ input) + (case (parser input) + (#try.Failure msg) + (<any> input) + + _ + (exception.except ..expected_to_fail input)))))] + + [not Text ..any ""] + [not! Slice ..any! " (as a slice)"] ) (exception: #export (cannot_match {reference Text}) @@ -121,7 +131,7 @@ ["Reference" (/.format reference)])) (def: #export (this reference) - {#.doc "Lex a text if it matches the given sample."} + {#.doc (doc "Checks that a specific text shows up in the input.")} (-> Text (Parser Any)) (function (_ [offset tape]) (case (/.index_of' reference offset tape) @@ -129,10 +139,10 @@ (if (n.= offset where) (#try.Success [[("lux i64 +" (/.size reference) offset) tape] []]) - (exception.throw ..cannot_match [reference])) + (exception.except ..cannot_match [reference])) _ - (exception.throw ..cannot_match [reference])))) + (exception.except ..cannot_match [reference])))) (def: #export end! {#.doc "Ensure the parser's input is empty."} @@ -140,10 +150,10 @@ (function (_ (^@ input [offset tape])) (if (n.= offset (/.size tape)) (#try.Success [input []]) - (exception.throw ..unconsumed_input input)))) + (exception.except ..unconsumed_input input)))) (def: #export peek - {#.doc "Lex the next character (without consuming it from the input)."} + {#.doc "Yields the next character (without consuming it from the input)."} (Parser Text) (function (_ (^@ input [offset tape])) (case (/.nth offset tape) @@ -151,16 +161,16 @@ (#try.Success [input (/.of_code output)]) _ - (exception.throw ..cannot_parse [])))) + (exception.except ..cannot_parse [])))) -(def: #export get_input +(def: #export remaining {#.doc "Get all of the remaining input (without consuming it)."} (Parser Text) (function (_ (^@ input [offset tape])) - (#try.Success [input (remaining offset tape)]))) + (#try.Success [input (remaining' offset tape)]))) (def: #export (range bottom top) - {#.doc "Only lex characters within a range."} + {#.doc "Only yields characters within a range."} (-> Nat Nat (Parser Text)) (do //.monad [char any @@ -168,11 +178,11 @@ _ (//.assert ($_ /\compose "Character is not within range: " (/.of_code bottom) "-" (/.of_code top)) (.and (n.>= bottom char') (n.<= top char')))] - (wrap char))) + (in char))) (template [<name> <bottom> <top> <desc>] [(def: #export <name> - {#.doc (code.text ($_ /\compose "Only lex " <desc> " characters."))} + {#.doc (code.text ($_ /\compose "Only yields " <desc> " characters."))} (Parser Text) (..range (char <bottom>) (char <top>)))] @@ -183,17 +193,17 @@ ) (def: #export alpha - {#.doc "Only lex alphabetic characters."} + {#.doc "Yields alphabetic characters."} (Parser Text) (//.either lower upper)) (def: #export alpha_num - {#.doc "Only lex alphanumeric characters."} + {#.doc "Yields alphanumeric characters."} (Parser Text) (//.either alpha decimal)) (def: #export hexadecimal - {#.doc "Only lex hexadecimal digits."} + {#.doc "Yields hexadecimal digits."} (Parser Text) ($_ //.either decimal @@ -212,7 +222,7 @@ (template [<name> <modifier> <exception> <description_modifier>] [(def: #export (<name> options) - {#.doc (code.text ($_ /\compose "Only lex characters that are" <description_modifier> " part of a piece of text."))} + {#.doc (code.text ($_ /\compose "Yields characters that are" <description_modifier> " part of a piece of text."))} (-> Text (Parser Text)) (function (_ [offset tape]) (case (/.nth offset tape) @@ -220,10 +230,10 @@ (let [output' (/.of_code output)] (if (<modifier> (/.contains? output' options)) (#try.Success [[("lux i64 +" 1 offset) tape] output']) - (exception.throw <exception> [options output]))) + (exception.except <exception> [options output]))) _ - (exception.throw ..cannot_parse []))))] + (exception.except ..cannot_parse []))))] [one_of |> ..character_should_be ""] [none_of .not ..character_should_not_be " not"] @@ -231,7 +241,7 @@ (template [<name> <modifier> <exception> <description_modifier>] [(def: #export (<name> options) - {#.doc (code.text ($_ /\compose "Only lex characters that are" <description_modifier> " part of a piece of text."))} + {#.doc (code.text ($_ /\compose "Yields characters (as a slice) that are" <description_modifier> " part of a piece of text."))} (-> Text (Parser Slice)) (function (_ [offset tape]) (case (/.nth offset tape) @@ -241,10 +251,10 @@ (#try.Success [[("lux i64 +" 1 offset) tape] {#basis offset #distance 1}]) - (exception.throw <exception> [options output]))) + (exception.except <exception> [options output]))) _ - (exception.throw ..cannot_slice []))))] + (exception.except ..cannot_slice []))))] [one_of! |> ..character_should_be ""] [none_of! .not ..character_should_not_be " not"] @@ -254,41 +264,43 @@ (exception.report ["Character" (/.format (/.of_code character))])) -(def: #export (satisfies p) - {#.doc "Only lex characters that satisfy a predicate."} +(def: #export (satisfies parser) + {#.doc "Yields characters that satisfy a predicate."} (-> (-> Char Bit) (Parser Text)) (function (_ [offset tape]) (case (/.nth offset tape) (#.Some output) - (if (p output) + (if (parser output) (#try.Success [[("lux i64 +" 1 offset) tape] (/.of_code output)]) - (exception.throw ..character_does_not_satisfy_predicate [output])) + (exception.except ..character_does_not_satisfy_predicate [output])) _ - (exception.throw ..cannot_parse [])))) + (exception.except ..cannot_parse [])))) (def: #export space - {#.doc "Only lex white-space."} + {#.doc "Yields white-space."} (Parser Text) (..satisfies /.space?)) (def: #export (and left right) + {#.doc (doc "Yields the outputs of both parsers composed together.")} (-> (Parser Text) (Parser Text) (Parser Text)) (do //.monad [=left left =right right] - (wrap ($_ /\compose =left =right)))) + (in ($_ /\compose =left =right)))) (def: #export (and! left right) + {#.doc (doc "Yields the outputs of both parsers composed together (as a slice).")} (-> (Parser Slice) (Parser Slice) (Parser Slice)) (do //.monad [[left::basis left::distance] left [right::basis right::distance] right] - (wrap [left::basis ("lux i64 +" left::distance right::distance)]))) + (in [left::basis ("lux i64 +" left::distance right::distance)]))) (template [<name> <base> <doc_modifier>] [(def: #export (<name> parser) - {#.doc (code.text ($_ /\compose "Lex " <doc_modifier> " characters as a single continuous text."))} + {#.doc (code.text ($_ /\compose "Yields " <doc_modifier> " characters as a single continuous text (as a slice)."))} (-> (Parser Text) (Parser Text)) (|> parser <base> (\ //.monad map /.concat)))] @@ -298,7 +310,7 @@ (template [<name> <base> <doc_modifier>] [(def: #export (<name> parser) - {#.doc (code.text ($_ /\compose "Lex " <doc_modifier> " characters as a single continuous text."))} + {#.doc (code.text ($_ /\compose "Yields " <doc_modifier> " characters as a single continuous text (as a slice)."))} (-> (Parser Slice) (Parser Slice)) (with_slices (<base> parser)))] @@ -308,7 +320,7 @@ (template [<name> <base> <doc_modifier>] [(def: #export (<name> amount parser) - {#.doc (code.text ($_ /\compose "Lex " <doc_modifier> " N characters."))} + {#.doc (code.text ($_ /\compose "Yields " <doc_modifier> " N characters (as a slice)."))} (-> Nat (Parser Text) (Parser Text)) (|> parser (<base> amount) (\ //.monad map /.concat)))] @@ -319,7 +331,7 @@ (template [<name> <base> <doc_modifier>] [(def: #export (<name> amount parser) - {#.doc (code.text ($_ /\compose "Lex " <doc_modifier> " N characters."))} + {#.doc (code.text ($_ /\compose "Yields " <doc_modifier> " N characters (as a slice)."))} (-> Nat (Parser Slice) (Parser Slice)) (with_slices (<base> amount parser)))] @@ -329,12 +341,12 @@ ) (def: #export (between from to parser) - {#.doc "Lex between N and M characters."} + {#.doc "Yields between N and M characters."} (-> Nat Nat (Parser Text) (Parser Text)) (|> parser (//.between from to) (\ //.monad map /.concat))) (def: #export (between! from to parser) - {#.doc "Lex between N and M characters."} + {#.doc "Yields between N and M characters (as a slice)."} (-> Nat Nat (Parser Slice) (Parser Slice)) (with_slices (//.between from to parser))) @@ -345,7 +357,7 @@ (//.after (this start)))) (def: #export (local local_input parser) - {#.doc "Run a parser with the given input, instead of the real one."} + {#.doc "Applies a parser against the given input."} (All [a] (-> Text (Parser a) (Parser a))) (function (_ real_input) (case (..run parser local_input) @@ -356,6 +368,7 @@ (#try.Success [real_input value])))) (def: #export (slice parser) + {#.doc (doc "Converts a slice to a block of text.")} (-> (Parser Slice) (Parser Text)) (do //.monad [[basis distance] parser] @@ -365,9 +378,10 @@ (#try.Success [input output]) #.None - (exception.throw ..cannot_slice []))))) + (exception.except ..cannot_slice []))))) -(def: #export (embed structured text) +(def: #export (then structured text) + {#.doc (doc "Embeds a text parser into an arbitrary parser that yields text.")} (All [s a] (-> (Parser a) (//.Parser s Text) diff --git a/stdlib/source/library/lux/control/parser/tree.lux b/stdlib/source/library/lux/control/parser/tree.lux index 6f2080628..11673474c 100644 --- a/stdlib/source/library/lux/control/parser/tree.lux +++ b/stdlib/source/library/lux/control/parser/tree.lux @@ -13,48 +13,63 @@ ["." //]) (type: #export (Parser t a) + {#.doc (doc "A parser of arbitrary trees.")} (//.Parser (Zipper t) a)) (def: #export (run' parser zipper) + {#.doc (doc "Applies the parser against a tree zipper.")} (All [t a] (-> (Parser t a) (Zipper t) (Try a))) (do try.monad [[zipper output] (//.run parser zipper)] - (wrap output))) + (in output))) (def: #export (run parser tree) + {#.doc (doc "Applies the parser against a tree.")} (All [t a] (-> (Parser t a) (Tree t) (Try a))) (run' parser (zipper.zip tree))) (def: #export value + {#.doc (doc "Yields the value inside the current tree node.")} (All [t] (Parser t t)) (function (_ zipper) (#try.Success [zipper (zipper.value zipper)]))) (exception: #export cannot_move_further) -(template [<name> <direction>] +(template [<name> <direction> <doc>] [(def: #export <name> + {#.doc (doc <doc>)} (All [t] (Parser t [])) (function (_ zipper) (case (<direction> zipper) #.None - (exception.throw ..cannot_move_further []) + (exception.except ..cannot_move_further []) (#.Some next) (#try.Success [next []]))))] - [down zipper.down] - [up zipper.up] + [down zipper.down + "Move down."] + [up zipper.up + "Move up."] - [right zipper.right] - [rightmost zipper.rightmost] + [right zipper.right + "Move to the right."] + [rightmost zipper.rightmost + "Move to the rightmost node."] - [left zipper.left] - [leftmost zipper.leftmost] + [left zipper.left + "Move to the left."] + [leftmost zipper.leftmost + "Move to the leftmost node."] - [next zipper.next] - [end zipper.end] + [next zipper.next + "Move to the next node."] + [end zipper.end + "Move to the last node."] - [previous zipper.previous] - [start zipper.start] + [previous zipper.previous + "Move to the previous node."] + [start zipper.start + "Move to the root node."] ) diff --git a/stdlib/source/library/lux/control/parser/type.lux b/stdlib/source/library/lux/control/parser/type.lux index d76254fe8..d8177a553 100644 --- a/stdlib/source/library/lux/control/parser/type.lux +++ b/stdlib/source/library/lux/control/parser/type.lux @@ -1,4 +1,6 @@ (.module: + {#.doc (.doc "Parsing of Lux types." + "Used mostly for polytypic programming.")} [library [lux (#- function) [abstract @@ -14,7 +16,8 @@ ["." list ("#\." functor)] ["." dictionary (#+ Dictionary)]]] [macro - ["." code]] + ["." code] + ["." template]] [math [number ["n" nat ("#\." decimal)]]] @@ -58,12 +61,15 @@ (text.join_with ""))])) (type: #export Env + {#.doc (doc "An environment for type parsing.")} (Dictionary Nat [Type Code])) (type: #export (Parser a) + {#.doc (doc "A parser of Lux types.")} (//.Parser [Env (List Type)] a)) (def: #export fresh + {#.doc (doc "An empty parsing environment.")} Env (dictionary.new n.hash)) @@ -79,13 +85,16 @@ (#try.Success output) _ - (exception.throw ..unconsumed_input remaining)))) + (exception.except ..unconsumed_input remaining)))) (def: #export (run poly type) + {#.doc (doc "Applies a parser against a type." + "Verifies that the parser fully consumes the type's information.")} (All [a] (-> (Parser a) Type (Try a))) (run' ..fresh poly (list type))) (def: #export env + {#.doc (doc "Yields the current parsing environment.")} (Parser Env) (.function (_ [env inputs]) (#try.Success [[env inputs] env]))) @@ -101,26 +110,29 @@ (#try.Success [[env remaining] output])))) (def: #export peek + {#.doc (doc "Inspect a type in the input stream without consuming it.")} (Parser Type) (.function (_ [env inputs]) (case inputs #.Nil - (exception.throw ..empty_input []) + (exception.except ..empty_input []) (#.Cons headT tail) (#try.Success [[env inputs] headT])))) (def: #export any + {#.doc (doc "Yields a type, without examination.")} (Parser Type) (.function (_ [env inputs]) (case inputs #.Nil - (exception.throw ..empty_input []) + (exception.except ..empty_input []) (#.Cons headT tail) (#try.Success [[env tail] headT])))) (def: #export (local types poly) + {#.doc (doc "Apply a parser to the given inputs.")} (All [a] (-> (List Type) (Parser a) (Parser a))) (.function (_ [env pass_through]) (case (run' env poly types) @@ -149,14 +161,15 @@ (#try.Success [[env inputs'] [g!var output]]))))) (template [<name> <flattener> <tag> <exception>] - [(def: #export (<name> poly) - (All [a] (-> (Parser a) (Parser a))) - (do //.monad - [headT ..any] - (let [members (<flattener> (type.anonymous headT))] - (if (n.> 1 (list.size members)) - (local members poly) - (//.failure (exception.construct <exception> headT))))))] + [(`` (def: #export (<name> poly) + {#.doc (doc (~~ (template.text ["Parses the contents of a " <name> " type."])))} + (All [a] (-> (Parser a) (Parser a))) + (do //.monad + [headT ..any] + (let [members (<flattener> (type.anonymous headT))] + (if (n.> 1 (list.size members)) + (local members poly) + (//.failure (exception.construct <exception> headT)))))))] [variant type.flat_variant #.Sum ..not_variant] [tuple type.flat_tuple #.Product ..not_tuple] @@ -169,7 +182,7 @@ #let [[num_arg bodyT] (type.flat_univ_q (type.anonymous headT))]] (if (n.= 0 num_arg) (//.failure (exception.construct ..not_polymorphic headT)) - (wrap [num_arg bodyT])))) + (in [num_arg bodyT])))) (def: #export (polymorphic poly) (All [a] (-> (Parser a) (Parser [Code (List Code) a]))) @@ -206,9 +219,10 @@ (local (list non_poly)) (do ! [output poly] - (wrap [funcL all_varsL output]))))) + (in [funcL all_varsL output]))))) (def: #export (function in_poly out_poly) + {#.doc (doc "Parses a function's inputs and output.")} (All [i o] (-> (Parser i) (Parser o) (Parser [i o]))) (do //.monad [headT any @@ -219,6 +233,7 @@ (//.failure (exception.construct ..not_function headT))))) (def: #export (applied poly) + {#.doc (doc "Parses a type application.")} (All [a] (-> (Parser a) (Parser a))) (do //.monad [headT any @@ -227,18 +242,22 @@ (//.failure (exception.construct ..not_application headT)) (..local (#.Cons funcT paramsT) poly)))) -(template [<name> <test>] +(template [<name> <test> <doc>] [(def: #export (<name> expected) + {#.doc (doc <doc>)} (-> Type (Parser Any)) (do //.monad [actual any] (if (<test> expected actual) - (wrap []) + (in []) (//.failure (exception.construct ..types_do_not_match [expected actual])))))] - [exactly type\=] - [sub check.checks?] - [super (function.flip check.checks?)] + [exactly type\= + "Parses a type exactly."] + [sub check.checks? + "Parses a sub type."] + [super (function.flip check.checks?) + "Parses a super type."] ) (def: #export (adjusted_idx env idx) @@ -257,7 +276,7 @@ (#.Parameter idx) (case (dictionary.get (adjusted_idx env idx) env) (#.Some [poly_type poly_code]) - (wrap poly_code) + (in poly_code) #.None (//.failure (exception.construct ..unknown_parameter headT))) @@ -273,30 +292,32 @@ (case headT (#.Parameter idx) (if (n.= id (adjusted_idx env idx)) - (wrap []) + (in []) (//.failure (exception.construct ..wrong_parameter [(#.Parameter id) headT]))) _ (//.failure (exception.construct ..not_parameter headT))))) (def: #export existential + {#.doc (doc "Yields an existential type.")} (Parser Nat) (do //.monad [headT any] (case headT (#.Ex ex_id) - (wrap ex_id) + (in ex_id) _ (//.failure (exception.construct ..not_existential headT))))) (def: #export named + {#.doc (doc "Yields a named type.")} (Parser [Name Type]) (do //.monad [inputT any] (case inputT (#.Named name anonymousT) - (wrap [name anonymousT]) + (in [name anonymousT]) _ (//.failure (exception.construct ..not_named inputT))))) @@ -317,7 +338,7 @@ (with_extension .Nothing) (with_extension headT) (local (list headT')))] - (wrap [recT output])) + (in [recT output])) _ (//.failure (exception.construct ..not_recursive headT))))) @@ -331,7 +352,7 @@ (^multi (^ (#.Apply (|nothing|) (#.Parameter funcT_idx))) (n.= 0 (adjusted_idx env funcT_idx)) {(dictionary.get 0 env) (#.Some [self_type self_call])}) - (wrap self_call) + (in self_call) _ (//.failure (exception.construct ..not_recursive headT))))) @@ -346,4 +367,4 @@ (|> allT (monad.map ! (function.constant ..parameter)) (local allT)))] - (wrap (` ((~+ allC)))))) + (in (` ((~+ allC)))))) diff --git a/stdlib/source/library/lux/control/parser/xml.lux b/stdlib/source/library/lux/control/parser/xml.lux index 3fed4030e..eb11fb3fd 100644 --- a/stdlib/source/library/lux/control/parser/xml.lux +++ b/stdlib/source/library/lux/control/parser/xml.lux @@ -18,6 +18,7 @@ ["." //]) (type: #export (Parser a) + {#.doc (doc "A parser of XML-encoded data.")} (//.Parser [Attrs (List XML)] a)) (exception: #export empty_input) @@ -43,21 +44,24 @@ (#try.Success [[attrs' remaining] output]) (if (list.empty? remaining) (#try.Success output) - (exception.throw ..unconsumed_inputs remaining)) + (exception.except ..unconsumed_inputs remaining)) (#try.Failure error) (#try.Failure error))) (def: #export (run parser documents) + {#.doc (doc "Applies a parser against a stream of XML documents." + "Verifies that all of the inputs are consumed by the parser.")} (All [a] (-> (Parser a) (List XML) (Try a))) (..run' parser /.attributes documents)) (def: #export text + {#.doc (doc "Yields text from a text node.")} (Parser Text) (function (_ [attrs documents]) (case documents #.Nil - (exception.throw ..empty_input []) + (exception.except ..empty_input []) (#.Cons head tail) (case head @@ -65,58 +69,62 @@ (#try.Success [[attrs tail] value]) (#/.Node _) - (exception.throw ..unexpected_input []))))) + (exception.except ..unexpected_input []))))) (def: #export tag + {#.doc (doc "Yields the tag from the next node.")} (Parser Tag) (function (_ [attrs documents]) (case documents #.Nil - (exception.throw ..empty_input []) + (exception.except ..empty_input []) (#.Cons head _) (case head (#/.Text _) - (exception.throw ..unexpected_input []) + (exception.except ..unexpected_input []) (#/.Node tag _ _) (#try.Success [[attrs documents] tag]))))) (def: #export (attribute name) + {#.doc (doc "Yields the value of an attribute in the current node.")} (-> Attribute (Parser Text)) (function (_ [attrs documents]) (case (dictionary.get name attrs) #.None - (exception.throw ..unknown_attribute [name (dictionary.keys attrs)]) + (exception.except ..unknown_attribute [name (dictionary.keys attrs)]) (#.Some value) (#try.Success [[attrs documents] value])))) (def: #export (node expected parser) + {#.doc (doc "Parses the contents of the next node if the tag matches.")} (All [a] (-> Tag (Parser a) (Parser a))) (function (_ [attrs documents]) (case documents #.Nil - (exception.throw ..empty_input []) + (exception.except ..empty_input []) (#.Cons head tail) (case head (#/.Text _) - (exception.throw ..unexpected_input []) + (exception.except ..unexpected_input []) (#/.Node actual attrs' children) (if (name\= expected actual) (|> children (..run' parser attrs') (try\map (|>> [[attrs tail]]))) - (exception.throw ..wrong_tag [expected actual])))))) + (exception.except ..wrong_tag [expected actual])))))) (def: #export ignore + {#.doc (doc "Skips the next node.")} (Parser Any) (function (_ [attrs documents]) (case documents #.Nil - (exception.throw ..empty_input []) + (exception.except ..empty_input []) (#.Cons head tail) (#try.Success [[attrs tail] []])))) @@ -124,6 +132,7 @@ (exception: #export nowhere) (def: #export (somewhere parser) + {#.doc (doc "Applies the parser somewhere among the remaining inputs; instead of demanding that the parser succeeds against the immediate inputs.")} (All [a] (-> (Parser a) (Parser a))) (function (recur [attrs input]) (case (//.run parser [attrs input]) @@ -133,10 +142,10 @@ (#try.Failure error) (case input #.Nil - (exception.throw ..nowhere []) + (exception.except ..nowhere []) (#.Cons head tail) (do try.monad [[[attrs tail'] output] (recur [attrs tail])] - (wrap [[attrs (#.Cons head tail')] - output])))))) + (in [[attrs (#.Cons head tail')] + output])))))) diff --git a/stdlib/source/library/lux/control/pipe.lux b/stdlib/source/library/lux/control/pipe.lux index cac70fe6b..1945eec59 100644 --- a/stdlib/source/library/lux/control/pipe.lux +++ b/stdlib/source/library/lux/control/pipe.lux @@ -1,4 +1,5 @@ -(.module: {#.doc "Composable extensions to the piping macros (|> and <|) that enhance them with various abilities."} +(.module: + {#.doc "Composable extensions to the piping macros (|> and <|) that enhance them with various abilities."} [library [lux #* [abstract @@ -32,15 +33,15 @@ (n.* 3) (n.+ 4) (new> 0 [inc]))))} - (wrap (list (` (|> (~ start) (~+ body)))))) + (in (list (` (|> (~ start) (~+ body)))))) (syntax: #export (let> binding body prev) {#.doc (doc "Gives a name to the piped-argument, within the given expression." (n.= 10 (|> 5 (let> x (n.+ x x)))))} - (wrap (list (` (let [(~ binding) (~ prev)] - (~ body)))))) + (in (list (` (let [(~ binding) (~ prev)] + (~ body)))))) (def: _reverse_ (Parser Any) @@ -59,22 +60,22 @@ [i.odd?] [(i.* +3)] [(new> -1 [])])))} (with_gensyms [g!temp] - (wrap (list (` (let [(~ g!temp) (~ prev)] - (cond (~+ (do list.monad - [[test then] branches] - (list (` (|> (~ g!temp) (~+ test))) - (` (|> (~ g!temp) (~+ then)))))) - (|> (~ g!temp) (~+ else))))))))) + (in (list (` (let [(~ g!temp) (~ prev)] + (cond (~+ (do list.monad + [[test then] branches] + (list (` (|> (~ g!temp) (~+ test))) + (` (|> (~ g!temp) (~+ then)))))) + (|> (~ g!temp) (~+ else))))))))) (syntax: #export (if> {test body^} {then body^} {else body^} prev) - (wrap (list (` (cond> [(~+ test)] [(~+ then)] - [(~+ else)] - (~ prev)))))) + (in (list (` (cond> [(~+ test)] [(~+ then)] + [(~+ else)] + (~ prev)))))) (syntax: #export (when> {test body^} {then body^} prev) - (wrap (list (` (cond> [(~+ test)] [(~+ then)] - [] - (~ prev)))))) + (in (list (` (cond> [(~+ test)] [(~+ then)] + [] + (~ prev)))))) (syntax: #export (loop> {test body^} {then body^} @@ -85,10 +86,10 @@ (loop> [(i.< +10)] [inc])))} (with_gensyms [g!temp] - (wrap (list (` (loop [(~ g!temp) (~ prev)] - (if (|> (~ g!temp) (~+ test)) - ((~' recur) (|> (~ g!temp) (~+ then))) - (~ g!temp)))))))) + (in (list (` (loop [(~ g!temp) (~ prev)] + (if (|> (~ g!temp) (~+ test)) + ((~' recur) (|> (~ g!temp) (~+ then))) + (~ g!temp)))))))) (syntax: #export (do> monad {steps (p.some body^)} @@ -106,13 +107,13 @@ (let [step_bindings (do list.monad [step (list.reverse prev_steps)] (list g!temp (` (|> (~ g!temp) (~+ step)))))] - (wrap (list (` ((~! do) (~ monad) - [(~' #let) [(~ g!temp) (~ prev)] - (~+ step_bindings)] - (|> (~ g!temp) (~+ last_step))))))) + (in (list (` ((~! do) (~ monad) + [(~' #let) [(~ g!temp) (~ prev)] + (~+ step_bindings)] + (|> (~ g!temp) (~+ last_step))))))) _ - (wrap (list prev))))) + (in (list prev))))) (syntax: #export (exec> {body body^} prev) @@ -122,9 +123,9 @@ (exec> [.nat %n log!]) (i.* +10)))} (with_gensyms [g!temp] - (wrap (list (` (let [(~ g!temp) (~ prev)] - (exec (|> (~ g!temp) (~+ body)) - (~ g!temp)))))))) + (in (list (` (let [(~ g!temp) (~ prev)] + (exec (|> (~ g!temp) (~+ body)) + (~ g!temp)))))))) (syntax: #export (tuple> {paths (p.many body^)} prev) @@ -136,9 +137,9 @@ [Int/encode])) "Will become: [+50 +2 '+5']")} (with_gensyms [g!temp] - (wrap (list (` (let [(~ g!temp) (~ prev)] - [(~+ (list\map (function (_ body) (` (|> (~ g!temp) (~+ body)))) - paths))])))))) + (in (list (` (let [(~ g!temp) (~ prev)] + [(~+ (list\map (function (_ body) (` (|> (~ g!temp) (~+ body)))) + paths))])))))) (syntax: #export (case> {branches (p.many (p.and s.any s.any))} prev) @@ -156,6 +157,6 @@ +8 "eight" +9 "nine" _ "???")))} - (wrap (list (` (case (~ prev) - (~+ (list\join (list\map (function (_ [pattern body]) (list pattern body)) - branches)))))))) + (in (list (` (case (~ prev) + (~+ (list\join (list\map (function (_ [pattern body]) (list pattern body)) + branches)))))))) diff --git a/stdlib/source/library/lux/control/reader.lux b/stdlib/source/library/lux/control/reader.lux index 95662b8ba..cf565cd22 100644 --- a/stdlib/source/library/lux/control/reader.lux +++ b/stdlib/source/library/lux/control/reader.lux @@ -45,7 +45,7 @@ (def: &functor ..functor) - (def: (wrap x) + (def: (in x) (function (_ env) x)) (def: (join mma) @@ -58,7 +58,7 @@ (def: &functor (functor.compose ..functor (get@ #monad.&functor monad))) - (def: wrap (|>> (\ monad wrap) (\ ..monad wrap))) + (def: in (|>> (\ monad in) (\ ..monad in))) (def: (join eMeMa) (function (_ env) @@ -69,4 +69,4 @@ (def: #export lift {#.doc "Lift monadic values to the Reader wrapper."} (All [M e a] (-> (M a) (Reader e (M a)))) - (\ ..monad wrap)) + (\ ..monad in)) diff --git a/stdlib/source/library/lux/control/region.lux b/stdlib/source/library/lux/control/region.lux index 83a0fe84d..98250983a 100644 --- a/stdlib/source/library/lux/control/region.lux +++ b/stdlib/source/library/lux/control/region.lux @@ -49,7 +49,7 @@ output (#try.Failure error) - (exception.throw ..clean_up_error [error output]))) + (exception.except ..clean_up_error [error output]))) (def: #export (run monad computation) (All [! a] @@ -59,15 +59,15 @@ [[cleaners output] (computation [[] (list)]) results (monad.map ! (function (_ cleaner) (cleaner [])) cleaners)] - (wrap (list\fold combine_outcomes output results)))) + (in (list\fold combine_outcomes output results)))) (def: #export (acquire monad cleaner value) (All [! a] (-> (Monad !) (-> a (! (Try Any))) a (All [r] (Region r ! a)))) (function (_ [region cleaners]) - (\ monad wrap [(#.Cons (function (_ region) (cleaner value)) - cleaners) - (#try.Success value)]))) + (\ monad in [(#.Cons (function (_ region) (cleaner value)) + cleaners) + (#try.Success value)]))) (implementation: #export (functor super) (All [!] @@ -104,13 +104,13 @@ (#try.Success f) (case ea (#try.Success a) - (wrap [cleaners (#try.Success (f a))]) + (in [cleaners (#try.Success (f a))]) (#try.Failure error) - (wrap [cleaners (#try.Failure error)])) + (in [cleaners (#try.Failure error)])) (#try.Failure error) - (wrap [cleaners (#try.Failure error)])))))) + (in [cleaners (#try.Failure error)])))))) (implementation: #export (monad super) (All [!] @@ -120,9 +120,9 @@ (def: &functor (..functor (get@ #monad.&functor super))) - (def: (wrap value) + (def: (in value) (function (_ [region cleaners]) - (\ super wrap [cleaners (#try.Success value)]))) + (\ super in [cleaners (#try.Success value)]))) (def: (join ffa) (function (_ [region cleaners]) @@ -133,16 +133,16 @@ (fa [region cleaners]) (#try.Failure error) - (wrap [cleaners (#try.Failure error)])))))) + (in [cleaners (#try.Failure error)])))))) (def: #export (failure monad error) (All [! a] (-> (Monad !) Text (All [r] (Region r ! a)))) (function (_ [region cleaners]) - (\ monad wrap [cleaners (#try.Failure error)]))) + (\ monad in [cleaners (#try.Failure error)]))) -(def: #export (throw monad exception message) +(def: #export (except monad exception message) (All [! e a] (-> (Monad !) (Exception e) e (All [r] (Region r ! a)))) @@ -155,4 +155,4 @@ (function (_ [region cleaners]) (do monad [output operation] - (wrap [cleaners (#try.Success output)])))) + (in [cleaners (#try.Success output)])))) diff --git a/stdlib/source/library/lux/control/remember.lux b/stdlib/source/library/lux/control/remember.lux index c2cc446ed..d8a6dc8a7 100644 --- a/stdlib/source/library/lux/control/remember.lux +++ b/stdlib/source/library/lux/control/remember.lux @@ -41,7 +41,7 @@ [raw <c>.text] (case (\ date.codec decode raw) (#try.Success date) - (wrap date) + (in date) (#try.Failure message) (<>.failure message))))) @@ -50,24 +50,24 @@ (let [now (io.run instant.now) today (instant.date now)] (if (date\< deadline today) - (wrap (case focus - (#.Some focus) - (list focus) + (in (case focus + (#.Some focus) + (list focus) - #.None - (list))) + #.None + (list))) (meta.failure (exception.construct ..must_remember [deadline today message focus]))))) (template [<name> <message>] [(syntax: #export (<name> {deadline ..deadline} {message <c>.text} {focus (<>.maybe <c>.any)}) - (wrap (list (` (..remember (~ (code.text (%.date deadline))) - (~ (code.text (format <message> " " message))) - (~+ (case focus - (#.Some focus) - (list focus) + (in (list (` (..remember (~ (code.text (%.date deadline))) + (~ (code.text (format <message> " " message))) + (~+ (case focus + (#.Some focus) + (list focus) - #.None - (list))))))))] + #.None + (list))))))))] [to_do "TODO"] [fix_me "FIXME"] diff --git a/stdlib/source/library/lux/control/security/capability.lux b/stdlib/source/library/lux/control/security/capability.lux index 100eea37e..14461791f 100644 --- a/stdlib/source/library/lux/control/security/capability.lux +++ b/stdlib/source/library/lux/control/security/capability.lux @@ -37,6 +37,7 @@ (|>> :abstraction)) (def: #export (use capability input) + {#.doc (doc "Applies a capability against its required input.")} (All [brand input output] (-> (Capability brand input output) input @@ -47,23 +48,34 @@ {declaration |declaration|.parser} {annotations (<>.maybe |annotations|.parser)} {[forge input output] (<c>.form ($_ <>.and <c>.local_identifier <c>.any <c>.any))}) + {#.doc (doc "Defines a capability as a unique type, and a constructor for instances." + + (capability: (Can_Duplicate a) + (can_duplicate a [a a])) + + (let [capability (can_duplicate + (function (_ value) + [value value])) + [left right] (..use capability 123)] + (is? left right)))} (do {! meta.monad} [this_module meta.current_module_name #let [[name vars] declaration] g!brand (\ ! map (|>> %.code code.text) (macro.gensym (format (%.name [this_module name])))) #let [capability (` (..Capability (.primitive (~ g!brand)) (~ input) (~ output)))]] - (wrap (list (` (type: (~+ (|export|.format export)) - (~ (|declaration|.format declaration)) - (~ capability))) - (` (def: (~ (code.local_identifier forge)) - (All [(~+ (list\map code.local_identifier vars))] - (-> (-> (~ input) (~ output)) - (~ capability))) - (~! ..forge))) - )))) + (in (list (` (type: (~+ (|export|.format export)) + (~ (|declaration|.format declaration)) + (~ capability))) + (` (def: (~ (code.local_identifier forge)) + (All [(~+ (list\map code.local_identifier vars))] + (-> (-> (~ input) (~ output)) + (~ capability))) + (~! ..forge))) + )))) (def: #export (async capability) + {#.doc (doc "Converts a synchronous I/O-based capability into an asynchronous capability.")} (All [brand input output] (-> (Capability brand input (IO output)) (Capability brand input (Async output)))) diff --git a/stdlib/source/library/lux/control/security/policy.lux b/stdlib/source/library/lux/control/security/policy.lux index 3c1eb579e..05b05cf5f 100644 --- a/stdlib/source/library/lux/control/security/policy.lux +++ b/stdlib/source/library/lux/control/security/policy.lux @@ -11,6 +11,8 @@ (abstract: #export (Policy brand value label) value + {#.doc (doc "A security policy encoded as the means to 'upgrade' or 'downgrade' in a secure context.")} + (type: #export (Can_Upgrade brand label value) {#.doc (doc "Represents the capacity to 'upgrade' a value.")} (-> value (Policy brand value label))) @@ -24,11 +26,6 @@ {#can_upgrade (Can_Upgrade brand label) #can_downgrade (Can_Downgrade brand label)}) - (def: privilege - Privilege - {#can_upgrade (|>> :abstraction) - #can_downgrade (|>> :representation)}) - (type: #export (Delegation brand from to) {#.doc (doc "Represents the act of delegating policy capacities.")} (All [value] @@ -47,7 +44,33 @@ (-> (Privilege brand label) (scope label))) + (def: privilege + Privilege + {#can_upgrade (|>> :abstraction) + #can_downgrade (|>> :representation)}) + (def: #export (with_policy context) + {#.doc (doc "Activates a security context with the priviledge to enforce it's policy." + + (type: Password + (Private Text)) + + (interface: (Policy %) + (: (-> Text (Password %)) + password) + (: (-> (Password %) Text) + unsafe)) + + (def: (policy _) + (Ex [%] (-> Any (Policy %))) + (with_policy + (: (Context Privacy Policy) + (function (_ (^open "%::.")) + (implementation + (def: (password value) + (%::can_upgrade value)) + (def: (unsafe password) + (%::can_downgrade password))))))))} (All [brand scope] (Ex [label] (-> (Context brand scope label) @@ -56,38 +79,51 @@ (def: (decorate constructor) (-> Type Type) - (type (All [brand label] (constructor (All [value] (Policy brand value label)))))) + (type (All [brand label] + (constructor (All [value] (Policy brand value label)))))) (implementation: #export functor - (:~ (decorate Functor)) + (:~ (..decorate Functor)) (def: (map f fa) (|> fa :representation f :abstraction))) (implementation: #export apply - (:~ (decorate Apply)) + (:~ (..decorate Apply)) (def: &functor ..functor) + (def: (apply ff fa) (:abstraction ((:representation ff) (:representation fa))))) (implementation: #export monad - (:~ (decorate Monad)) + (:~ (..decorate Monad)) (def: &functor ..functor) - (def: wrap (|>> :abstraction)) + (def: in (|>> :abstraction)) (def: join (|>> :representation))) ) -(template [<brand> <value> <upgrade> <downgrade>] +(template [<brand> <value> <upgrade> <downgrade> <doc>] [(abstract: #export <brand> Any + + {#.doc <doc>} + + (type: #export <value> + (Policy <brand>)) + + (type: #export <upgrade> + (Can_Upgrade <brand>)) - (type: #export <value> (Policy <brand>)) - (type: #export <upgrade> (Can_Upgrade <brand>)) - (type: #export <downgrade> (Can_Downgrade <brand>)) + (type: #export <downgrade> + (Can_Downgrade <brand>)) )] - [Privacy Private Can_Conceal Can_Reveal] - [Safety Safe Can_Trust Can_Distrust] + [Privacy Private Can_Conceal Can_Reveal + (doc "A security context for privacy." + "Private data is data which cannot be allowed to leak outside of the programmed.")] + [Safety Safe Can_Trust Can_Distrust + (doc "A security context for safety." + "Safe data is data coming from outside the program which can be trusted to be properly formatted and lacking injections.")] ) diff --git a/stdlib/source/library/lux/control/state.lux b/stdlib/source/library/lux/control/state.lux index b39690469..661c081d8 100644 --- a/stdlib/source/library/lux/control/state.lux +++ b/stdlib/source/library/lux/control/state.lux @@ -70,7 +70,7 @@ (def: &functor ..functor) - (def: (wrap a) + (def: (in a) (function (_ state) [state a])) @@ -87,7 +87,7 @@ (do ! [_ body] (while condition body)) - (wrap [])))) + (in [])))) (def: #export (do_while condition body) (All [s] (-> (State s Bit) (State s Any) (State s Any))) @@ -113,7 +113,7 @@ (do monad [[state f] (sFf state) [state a] (sFa state)] - (wrap [state (f a)]))))) + (in [state (f a)]))))) (type: #export (State' M s a) {#.doc "Stateful computations decorated by a monad."} @@ -130,9 +130,9 @@ (def: &functor (with//functor (\ monad &functor))) - (def: (wrap a) + (def: (in a) (function (_ state) - (\ monad wrap [state a]))) + (\ monad in [state a]))) (def: (join sMsMa) (function (_ state) @@ -146,4 +146,4 @@ (function (_ state) (do monad [a ma] - (wrap [state a])))) + (in [state a])))) diff --git a/stdlib/source/library/lux/control/thread.lux b/stdlib/source/library/lux/control/thread.lux index 818c38298..ec2e48153 100644 --- a/stdlib/source/library/lux/control/thread.lux +++ b/stdlib/source/library/lux/control/thread.lux @@ -90,7 +90,7 @@ (def: &functor ..functor) - (def: (wrap value) + (def: (in value) (function (_ !) value)) @@ -103,4 +103,4 @@ (do ..monad [old (read box) _ (write (f old) box)] - (wrap old))) + (in old))) diff --git a/stdlib/source/library/lux/control/try.lux b/stdlib/source/library/lux/control/try.lux index 77adf79f0..52f58495a 100644 --- a/stdlib/source/library/lux/control/try.lux +++ b/stdlib/source/library/lux/control/try.lux @@ -47,7 +47,7 @@ (def: &functor ..functor) - (def: (wrap a) + (def: (in a) (#Success a)) (def: (join mma) @@ -64,21 +64,21 @@ (def: &functor (functor.compose (get@ #monad.&functor monad) ..functor)) - (def: wrap (|>> (\ ..monad wrap) (\ monad wrap))) + (def: in (|>> (\ ..monad in) (\ monad in))) (def: (join MeMea) (do monad [eMea MeMea] (case eMea (#Failure try) - (wrap (#Failure try)) + (in (#Failure try)) (#Success Mea) Mea)))) (def: #export (lifted monad) (All [M a] (-> (Monad M) (-> (M a) (M (Try a))))) - (\ monad map (\ ..monad wrap))) + (\ monad map (\ ..monad in))) (implementation: #export (equivalence (^open "_\.")) (All [a] (-> (Equivalence a) (Equivalence (Try a)))) diff --git a/stdlib/source/library/lux/control/writer.lux b/stdlib/source/library/lux/control/writer.lux index 2ddf343df..8fd8e9492 100644 --- a/stdlib/source/library/lux/control/writer.lux +++ b/stdlib/source/library/lux/control/writer.lux @@ -43,7 +43,7 @@ (def: &functor ..functor) - (def: wrap + (def: in (|>> [(\ monoid identity)])) (def: (join mma) @@ -57,9 +57,9 @@ (functor.compose (get@ #monad.&functor monad) ..functor)) - (def: wrap + (def: in (let [writer (..monad monoid)] - (|>> (\ writer wrap) (\ monad wrap)))) + (|>> (\ writer in) (\ monad in)))) (def: (join MlMla) (do monad @@ -69,7 +69,7 @@ ## On new compiler MlMla) [l2 a] Mla] - (wrap [(\ monoid compose l1 l2) a])))) + (in [(\ monoid compose l1 l2) a])))) (def: #export (lift monoid monad) (All [l M a] diff --git a/stdlib/source/library/lux/data/binary.lux b/stdlib/source/library/lux/data/binary.lux index 11bc86754..185a142bf 100644 --- a/stdlib/source/library/lux/data/binary.lux +++ b/stdlib/source/library/lux/data/binary.lux @@ -194,7 +194,7 @@ (-> Nat Binary (Try I64)) (if (n.< (..!size binary) idx) (#try.Success (!read idx binary)) - (exception.throw ..index_out_of_bounds [(..!size binary) idx]))) + (exception.except ..index_out_of_bounds [(..!size binary) idx]))) (def: #export (read/16 idx binary) (-> Nat Binary (Try I64)) @@ -202,7 +202,7 @@ (#try.Success ($_ i64.or (i64.left_shift 8 (!read idx binary)) (!read (n.+ 1 idx) binary))) - (exception.throw ..index_out_of_bounds [(..!size binary) idx]))) + (exception.except ..index_out_of_bounds [(..!size binary) idx]))) (def: #export (read/32 idx binary) (-> Nat Binary (Try I64)) @@ -212,7 +212,7 @@ (i64.left_shift 16 (!read (n.+ 1 idx) binary)) (i64.left_shift 8 (!read (n.+ 2 idx) binary)) (!read (n.+ 3 idx) binary))) - (exception.throw ..index_out_of_bounds [(..!size binary) idx]))) + (exception.except ..index_out_of_bounds [(..!size binary) idx]))) (def: #export (read/64 idx binary) (-> Nat Binary (Try I64)) @@ -226,14 +226,14 @@ (i64.left_shift 16 (!read (n.+ 5 idx) binary)) (i64.left_shift 8 (!read (n.+ 6 idx) binary)) (!read (n.+ 7 idx) binary))) - (exception.throw ..index_out_of_bounds [(..!size binary) idx]))) + (exception.except ..index_out_of_bounds [(..!size binary) idx]))) (def: #export (write/8 idx value binary) (-> Nat (I64 Any) Binary (Try Binary)) (if (n.< (..!size binary) idx) (#try.Success (|> binary (!write idx value))) - (exception.throw ..index_out_of_bounds [(..!size binary) idx]))) + (exception.except ..index_out_of_bounds [(..!size binary) idx]))) (def: #export (write/16 idx value binary) (-> Nat (I64 Any) Binary (Try Binary)) @@ -241,7 +241,7 @@ (#try.Success (|> binary (!write idx (i64.right_shift 8 value)) (!write (n.+ 1 idx) value))) - (exception.throw ..index_out_of_bounds [(..!size binary) idx]))) + (exception.except ..index_out_of_bounds [(..!size binary) idx]))) (def: #export (write/32 idx value binary) (-> Nat (I64 Any) Binary (Try Binary)) @@ -251,7 +251,7 @@ (!write (n.+ 1 idx) (i64.right_shift 16 value)) (!write (n.+ 2 idx) (i64.right_shift 8 value)) (!write (n.+ 3 idx) value))) - (exception.throw ..index_out_of_bounds [(..!size binary) idx]))) + (exception.except ..index_out_of_bounds [(..!size binary) idx]))) (def: #export (write/64 idx value binary) (-> Nat (I64 Any) Binary (Try Binary)) @@ -274,7 +274,7 @@ (!write (n.+ 5 idx) (i64.right_shift 16 value)) (!write (n.+ 6 idx) (i64.right_shift 8 value)) (!write (n.+ 7 idx) value)))) - (exception.throw ..index_out_of_bounds [(..!size binary) idx]))) + (exception.except ..index_out_of_bounds [(..!size binary) idx]))) (implementation: #export equivalence (Equivalence Binary) @@ -309,7 +309,7 @@ (-> Nat Nat Binary Nat Binary (Try Binary)) (with_expansions [<jvm> (as_is (do try.monad [_ (java/lang/System::arraycopy source (.int source_offset) target (.int target_offset) (.int bytes))] - (wrap target)))] + (in target)))] (for {@.old <jvm> @.jvm <jvm>} @@ -324,7 +324,7 @@ target) (recur (inc idx))) (#try.Success target))) - (exception.throw ..cannot_copy_bytes [bytes source_input target_output])))))) + (exception.except ..cannot_copy_bytes [bytes source_input target_output])))))) (def: #export (slice offset length binary) (-> Nat Nat Binary (Try Binary)) @@ -337,7 +337,7 @@ ## Default (..copy length offset binary 0 (..create length)))) - (exception.throw ..slice_out_of_bounds [size offset length])))) + (exception.except ..slice_out_of_bounds [size offset length])))) (def: #export (drop offset binary) (-> Nat Binary Binary) diff --git a/stdlib/source/library/lux/data/collection/dictionary.lux b/stdlib/source/library/lux/data/collection/dictionary.lux index 5c740b072..490f3f3e0 100644 --- a/stdlib/source/library/lux/data/collection/dictionary.lux +++ b/stdlib/source/library/lux/data/collection/dictionary.lux @@ -594,7 +594,7 @@ (All [k v] (-> k v (Dictionary k v) (Try (Dictionary k v)))) (case (get key dict) #.None (#try.Success (put key val dict)) - (#.Some _) (exception.throw ..key_already_exists []))) + (#.Some _) (exception.except ..key_already_exists []))) (def: #export (update key f dict) {#.doc "Transforms the value located at key (if available), using the given function."} diff --git a/stdlib/source/library/lux/data/collection/dictionary/ordered.lux b/stdlib/source/library/lux/data/collection/dictionary/ordered.lux index 15d7f8077..cb187b477 100644 --- a/stdlib/source/library/lux/data/collection/dictionary/ordered.lux +++ b/stdlib/source/library/lux/data/collection/dictionary/ordered.lux @@ -410,25 +410,25 @@ [fused (prepend (get@ #right left) (get@ #right right))] (case (get@ #color fused) #Red - (wrap (red (get@ #key fused) - (get@ #value fused) - (#.Some (red (get@ #key left) - (get@ #value left) - (get@ #left left) - (get@ #left fused))) - (#.Some (red (get@ #key right) - (get@ #value right) - (get@ #right fused) - (get@ #right right))))) + (in (red (get@ #key fused) + (get@ #value fused) + (#.Some (red (get@ #key left) + (get@ #value left) + (get@ #left left) + (get@ #left fused))) + (#.Some (red (get@ #key right) + (get@ #value right) + (get@ #right fused) + (get@ #right right))))) #Black - (wrap (red (get@ #key left) - (get@ #value left) - (get@ #left left) - (#.Some (red (get@ #key right) - (get@ #value right) - (#.Some fused) - (get@ #right right))))))) + (in (red (get@ #key left) + (get@ #value left) + (get@ #left left) + (#.Some (red (get@ #key right) + (get@ #value right) + (#.Some fused) + (get@ #right right))))))) [#Red #Black] (#.Some (red (get@ #key left) @@ -449,25 +449,25 @@ [fused (prepend (get@ #right left) (get@ #left right))] (case (get@ #color fused) #Red - (wrap (red (get@ #key fused) - (get@ #value fused) - (#.Some (black (get@ #key left) - (get@ #value left) - (get@ #left left) - (get@ #left fused))) - (#.Some (black (get@ #key right) - (get@ #value right) - (get@ #right fused) - (get@ #right right))))) + (in (red (get@ #key fused) + (get@ #value fused) + (#.Some (black (get@ #key left) + (get@ #value left) + (get@ #left left) + (get@ #left fused))) + (#.Some (black (get@ #key right) + (get@ #value right) + (get@ #right fused) + (get@ #right right))))) #Black - (wrap (balance_left_remove (get@ #key left) - (get@ #value left) - (get@ #left left) - (#.Some (black (get@ #key right) - (get@ #value right) - (#.Some fused) - (get@ #right right))))) + (in (balance_left_remove (get@ #key left) + (get@ #value left) + (get@ #left left) + (#.Some (black (get@ #key right) + (get@ #value right) + (#.Some fused) + (get@ #right right))))) )) ) diff --git a/stdlib/source/library/lux/data/collection/list.lux b/stdlib/source/library/lux/data/collection/list.lux index 92b77bdf4..e1661f1a4 100644 --- a/stdlib/source/library/lux/data/collection/list.lux +++ b/stdlib/source/library/lux/data/collection/list.lux @@ -368,7 +368,7 @@ (def: &functor ..functor) - (def: (wrap a) + (def: (in a) (#.Cons a #.Nil)) (def: join (|>> reverse (fold compose identity)))) @@ -587,7 +587,7 @@ (def: &functor (functor.compose (get@ #monad.&functor monad) ..functor)) - (def: wrap (|>> (\ ..monad wrap) (\ monad wrap))) + (def: in (|>> (\ ..monad in) (\ monad in))) (def: (join MlMla) (do {! monad} @@ -597,11 +597,11 @@ (: (($ 0) (List (List ($ 1)))) (monad.seq ! lMla))} (monad.seq ! lMla))] - (wrap (concat lla))))) + (in (concat lla))))) (def: #export (lift monad) (All [M a] (-> (Monad M) (-> (M a) (M (List a))))) - (\ monad map (\ ..monad wrap))) + (\ monad map (\ ..monad in))) (def: #export (enumeration xs) {#.doc "Pairs every element in the list with its index, starting at 0."} diff --git a/stdlib/source/library/lux/data/collection/row.lux b/stdlib/source/library/lux/data/collection/row.lux index 69be85a21..6447d96fe 100644 --- a/stdlib/source/library/lux/data/collection/row.lux +++ b/stdlib/source/library/lux/data/collection/row.lux @@ -260,11 +260,11 @@ (#try.Success base) [_ #.None] - (exception.throw ..base_was_not_found []) + (exception.except ..base_was_not_found []) _ - (exception.throw ..incorrect_row_structure [])))) - (exception.throw ..index_out_of_bounds [row idx]))) + (exception.except ..incorrect_row_structure [])))) + (exception.except ..index_out_of_bounds [row idx]))) (def: #export (nth idx row) (All [a] (-> Nat (Row a) (Try a))) @@ -275,7 +275,7 @@ (#try.Success value) #.None - (exception.throw ..incorrect_row_structure [])))) + (exception.except ..incorrect_row_structure [])))) (def: #export (put idx val row) (All [a] (-> Nat a (Row a) (Try (Row a)))) @@ -289,7 +289,7 @@ row) (update@ #root (put' (get@ #level row) idx val) row))) - (exception.throw ..index_out_of_bounds [row idx])))) + (exception.except ..index_out_of_bounds [row idx])))) (def: #export (update idx f row) (All [a] (-> Nat (-> a a) (Row a) (Try (Row a)))) @@ -332,11 +332,11 @@ _ [level root]) [level root])))]] - (wrap (|> row - (update@ #size dec) - (set@ #level level') - (set@ #root root') - (set@ #tail new_tail)))))) + (in (|> row + (update@ #size dec) + (set@ #level level') + (set@ #root root') + (set@ #tail new_tail)))))) )) (def: #export (to_list row) @@ -359,7 +359,7 @@ (syntax: #export (row {elems (p.some s.any)}) {#.doc (doc "Row literals." (row +10 +20 +30 +40))} - (wrap (list (` (..of_list (list (~+ elems))))))) + (in (list (` (..of_list (list (~+ elems))))))) (implementation: (node_equivalence Equivalence<a>) (All [a] (-> (Equivalence a) (Equivalence (Node a)))) @@ -456,7 +456,7 @@ (def: &functor ..functor) - (def: wrap (|>> row)) + (def: in (|>> row)) (def: join (let [(^open ".") ..fold diff --git a/stdlib/source/library/lux/data/collection/sequence.lux b/stdlib/source/library/lux/data/collection/sequence.lux index 10bbfa9d0..3fe88a087 100644 --- a/stdlib/source/library/lux/data/collection/sequence.lux +++ b/stdlib/source/library/lux/data/collection/sequence.lux @@ -130,7 +130,7 @@ (def: &functor ..functor) - (def: unwrap head) + (def: out head) (def: (split wa) (let [[head tail] (//.run wa)] @@ -149,4 +149,4 @@ (` ((~! //.run) (~ g!sequence))))) patterns)))] (~ body)))] - (wrap (list& g!sequence body+ branches))))) + (in (list& g!sequence body+ branches))))) diff --git a/stdlib/source/library/lux/data/collection/tree.lux b/stdlib/source/library/lux/data/collection/tree.lux index 045b176c6..444ab32e2 100644 --- a/stdlib/source/library/lux/data/collection/tree.lux +++ b/stdlib/source/library/lux/data/collection/tree.lux @@ -56,9 +56,9 @@ {20 {} 30 {} 40 {}})))} - (wrap (list (` (~ (loop [[value children] root] - (` {#value (~ value) - #children (list (~+ (list\map recur children)))}))))))) + (in (list (` (~ (loop [[value children] root] + (` {#value (~ value) + #children (list (~+ (list\map recur children)))}))))))) (implementation: #export (equivalence super) (All [a] (-> (Equivalence a) (Equivalence (Tree a)))) diff --git a/stdlib/source/library/lux/data/collection/tree/zipper.lux b/stdlib/source/library/lux/data/collection/tree/zipper.lux index 942ca5c09..9803124a4 100644 --- a/stdlib/source/library/lux/data/collection/tree/zipper.lux +++ b/stdlib/source/library/lux/data/collection/tree/zipper.lux @@ -99,18 +99,18 @@ (All [a] (-> (Zipper a) (Maybe (Zipper a)))) (do maybe.monad [family (get@ #family zipper)] - (wrap (let [(^slots [#parent #lefts #rights]) family] - (for {@.old - (update@ #node (: (-> (Tree ($ 0)) (Tree ($ 0))) - (set@ #//.children (list\compose (list.reverse lefts) - (#.Cons (get@ #node zipper) - rights)))) - parent)} - (set@ [#node #//.children] - (list\compose (list.reverse lefts) - (#.Cons (get@ #node zipper) - rights)) - parent)))))) + (in (let [(^slots [#parent #lefts #rights]) family] + (for {@.old + (update@ #node (: (-> (Tree ($ 0)) (Tree ($ 0))) + (set@ #//.children (list\compose (list.reverse lefts) + (#.Cons (get@ #node zipper) + rights)))) + parent)} + (set@ [#node #//.children] + (list\compose (list.reverse lefts) + (#.Cons (get@ #node zipper) + rights)) + parent)))))) (template [<one> <all> <side> <op_side>] [(def: #export (<one> zipper) @@ -258,16 +258,16 @@ [family (get@ #family zipper)] (case (get@ #lefts family) #.Nil - (wrap (set@ [#node #//.children] - (get@ #rights family) - (get@ #parent family))) + (in (set@ [#node #//.children] + (get@ #rights family) + (get@ #parent family))) (#.Cons next side) - (wrap (|> zipper - (set@ #family (|> family - (set@ #lefts side) - #.Some)) - (set@ #node next)))))) + (in (|> zipper + (set@ #family (|> family + (set@ #lefts side) + #.Some)) + (set@ #node next)))))) (template [<name> <side>] [(def: #export (<name> value zipper) @@ -301,7 +301,7 @@ (def: &functor ..functor) - (def: unwrap (get@ [#node #//.value])) + (def: out (get@ [#node #//.value])) (def: (split (^slots [#family #node])) (let [tree_splitter (: (All [a] (-> (Tree a) (Tree (Zipper a)))) diff --git a/stdlib/source/library/lux/data/format/binary.lux b/stdlib/source/library/lux/data/format/binary.lux index c7bd7da94..b12e9f2e1 100644 --- a/stdlib/source/library/lux/data/format/binary.lux +++ b/stdlib/source/library/lux/data/format/binary.lux @@ -197,7 +197,7 @@ (try.assumed (do try.monad [_ (<write> offset capped_count binary)] - (wrap (mutation [(n.+ <size> offset) binary])))))])))] + (in (mutation [(n.+ <size> offset) binary])))))])))] [row/8 /.size/8 binary.write/8] [row/16 /.size/16 binary.write/16] diff --git a/stdlib/source/library/lux/data/format/css.lux b/stdlib/source/library/lux/data/format/css.lux index 041feace9..d94f97cd9 100644 --- a/stdlib/source/library/lux/data/format/css.lux +++ b/stdlib/source/library/lux/data/format/css.lux @@ -27,15 +27,19 @@ (abstract: #export (CSS brand) Text - (def: #export css (-> (CSS Any) Text) (|>> :representation)) + (def: #export css + (-> (CSS Any) Text) + (|>> :representation)) - (def: #export empty (CSS Common) (:abstraction "")) + (def: #export empty + (CSS Common) + (:abstraction "")) (def: #export (rule selector style) (-> (Selector Any) Style (CSS Common)) (:abstraction (format (/selector.selector selector) "{" (/style.inline style) "}"))) - (def: #export char-set + (def: #export char_set (-> Encoding (CSS Special)) (|>> encoding.name %.text @@ -44,23 +48,23 @@ (def: #export (font font) (-> Font (CSS Special)) - (let [with-unicode (case (get@ #/font.unicode-range font) - (#.Some unicode-range) - (let [unicode-range' (format "U+" (\ nat.hex encode (get@ #/font.start unicode-range)) - "-" (\ nat.hex encode (get@ #/font.end unicode-range)))] - (list ["unicode-range" unicode-range'])) + (let [with_unicode (case (get@ #/font.unicode_range font) + (#.Some unicode_range) + (let [unicode_range' (format "U+" (\ nat.hex encode (get@ #/font.start unicode_range)) + "-" (\ nat.hex encode (get@ #/font.end unicode_range)))] + (list ["unicode-range" unicode_range'])) #.None (list))] (|> (list& ["font-family" (get@ #/font.family font)] ["src" (format "url(" (get@ #/font.source font) ")")] - ["font-stretch" (|> font (get@ #/font.stretch) (maybe.default /value.normal-stretch) /value.value)] - ["font-style" (|> font (get@ #/font.style) (maybe.default /value.normal-style) /value.value)] - ["font-weight" (|> font (get@ #/font.weight) (maybe.default /value.normal-weight) /value.value)] - with-unicode) + ["font-stretch" (|> font (get@ #/font.stretch) (maybe.default /value.normal_stretch) /value.value)] + ["font-style" (|> font (get@ #/font.style) (maybe.default /value.normal_style) /value.value)] + ["font-weight" (|> font (get@ #/font.weight) (maybe.default /value.normal_weight) /value.value)] + with_unicode) (list\map (function (_ [property value]) (format property ": " value ";"))) - (text.join-with /style.separator) + (text.join_with /style.separator) (text.enclose ["{" "}"]) (format "@font-face") :abstraction))) @@ -76,13 +80,14 @@ "") ";"))) - (def: css-separator text.new-line) + (def: css_separator + text.new_line) (type: #export Frame {#when Percentage #what Style}) - (def: #export (key-frames animation frames) + (def: #export (key_frames animation frames) (-> (Value Animation) (List Frame) (CSS Special)) (:abstraction (format "@keyframes " (/value.value animation) " {" (|> frames @@ -90,11 +95,11 @@ (format (/value.percentage (get@ #when frame)) " {" (/style.inline (get@ #what frame)) "}"))) - (text.join-with ..css-separator)) + (text.join_with ..css_separator)) "}"))) (template: (!compose <pre> <post>) - (:abstraction (format (:representation <pre>) ..css-separator + (:abstraction (format (:representation <pre>) ..css_separator (:representation <post>)))) (def: #export (and pre post) @@ -105,9 +110,9 @@ (-> Combinator (Selector Any) (CSS Common) (CSS Common)) (|> css :representation - (text.split-all-with ..css-separator) + (text.split_all_with ..css_separator) (list\map (|>> (format (/selector.selector (|> selector (combinator (/selector.tag ""))))))) - (text.join-with ..css-separator) + (text.join_with ..css_separator) :abstraction)) (def: #export (dependent combinator selector style inner) @@ -120,7 +125,7 @@ (-> (Selector Any) Style (CSS Common) (CSS Common)) (..dependent <combinator>))] - [with-descendants /selector.in] - [with-children /selector.sub] + [with_descendants /selector.in] + [with_children /selector.sub] ) ) diff --git a/stdlib/source/library/lux/data/format/css/property.lux b/stdlib/source/library/lux/data/format/css/property.lux index 73544c26a..29f3681f9 100644 --- a/stdlib/source/library/lux/data/format/css/property.lux +++ b/stdlib/source/library/lux/data/format/css/property.lux @@ -53,7 +53,7 @@ Z_Index)]]) (syntax: (text_identifier {identifier s.text}) - (wrap (list (code.local_identifier (text.replace_all "-" "_" identifier))))) + (in (list (code.local_identifier (text.replace_all "-" "_" identifier))))) (abstract: #export (Property brand) Text diff --git a/stdlib/source/library/lux/data/format/css/query.lux b/stdlib/source/library/lux/data/format/css/query.lux index 3e40701eb..115aeaf97 100644 --- a/stdlib/source/library/lux/data/format/css/query.lux +++ b/stdlib/source/library/lux/data/format/css/query.lux @@ -16,13 +16,13 @@ ["." // #_ ["#." value (#+ Value Length Count Resolution Ratio Orientation Scan Boolean Update - Block-Overflow Inline-Overflow - Display-Mode Color-Gamut Inverted-Colors + Block_Overflow Inline_Overflow + Display_Mode Color_Gamut Inverted_Colors Pointer Hover - Light Scripting Motion Color-Scheme)]]) + Light Scripting Motion Color_Scheme)]]) -(syntax: (text-identifier {identifier s.text}) - (wrap (list (code.local-identifier identifier)))) +(syntax: (text_identifier {identifier s.text}) + (in (list (code.local_identifier (text.replace_all "-" "_" identifier))))) (abstract: #export Media Text @@ -32,7 +32,7 @@ (|>> :representation)) (template [<media>] - [(`` (def: #export (~~ (text-identifier <media>)) + [(`` (def: #export (~~ (text_identifier <media>)) Media (:abstraction <media>)))] @@ -50,7 +50,7 @@ (|>> :representation)) (template [<feature> <brand>] - [(`` (def: #export ((~~ (text-identifier <feature>)) input) + [(`` (def: #export ((~~ (text_identifier <feature>)) input) (-> (Value <brand>) Feature) (:abstraction (format "(" <feature> ": " (//value.value input) ")"))))] @@ -82,15 +82,15 @@ ["max-aspect-ratio" Ratio] ["min-aspect-ratio" Ratio] - ["display-mode" Display-Mode] - ["color-gamut" Color-Gamut] + ["display-mode" Display_Mode] + ["color-gamut" Color_Gamut] ["grid" Boolean] ["orientation" Orientation] - ["overflow-block" Block-Overflow] - ["overflow-inline" Inline-Overflow] + ["overflow-block" Block_Overflow] + ["overflow-inline" Inline_Overflow] ["scan" Scan] ["update" Update] - ["inverted-colors" Inverted-Colors] + ["inverted-colors" Inverted_Colors] ["pointer" Pointer] ["any-pointer" Pointer] ["hover" Hover] @@ -98,7 +98,7 @@ ["light-level" Light] ["scripting" Scripting] ["prefers-reduced-motion" Motion] - ["prefers-color-scheme" Color-Scheme] + ["prefers-color-scheme" Color_Scheme] ) ) diff --git a/stdlib/source/library/lux/data/format/css/value.lux b/stdlib/source/library/lux/data/format/css/value.lux index 5c6e575ed..85a775440 100644 --- a/stdlib/source/library/lux/data/format/css/value.lux +++ b/stdlib/source/library/lux/data/format/css/value.lux @@ -29,7 +29,7 @@ [selector (#+ Label)]]) (syntax: (text_identifier {identifier s.text}) - (wrap (list (code.local_identifier (text.replace_all "-" "_" identifier))))) + (in (list (code.local_identifier (text.replace_all "-" "_" identifier))))) (template: (enumeration: <abstraction> <representation> <out> <sample>+ <definition>+) (abstract: #export <abstraction> diff --git a/stdlib/source/library/lux/data/format/json.lux b/stdlib/source/library/lux/data/format/json.lux index 30903df3c..417e7791d 100644 --- a/stdlib/source/library/lux/data/format/json.lux +++ b/stdlib/source/library/lux/data/format/json.lux @@ -1,5 +1,6 @@ -(.module: {#.doc (.doc "Functionality for reading and writing values in the JSON format." - "For more information, please see: http://www.json.org/")} +(.module: + {#.doc (.doc "Functionality for reading and writing values in the JSON format." + "For more information, please see: http://www.json.org/")} [library [lux #* ["." meta (#+ monad)] @@ -79,16 +80,16 @@ (case token (^template [<ast_tag> <ctor> <json_tag>] [[_ (<ast_tag> value)] - (wrap (list (` (: JSON (<json_tag> (~ (<ctor> value)))))))]) + (in (list (` (: JSON (<json_tag> (~ (<ctor> value)))))))]) ([#.Bit code.bit #..Boolean] [#.Frac code.frac #..Number] [#.Text code.text #..String]) [_ (#.Tag ["" "null"])] - (wrap (list (` (: JSON #..Null)))) + (in (list (` (: JSON #..Null)))) [_ (#.Tuple members)] - (wrap (list (` (: JSON (#..Array ((~! row) (~+ (list\map wrapper members)))))))) + (in (list (` (: JSON (#..Array ((~! row) (~+ (list\map wrapper members)))))))) [_ (#.Record pairs)] (do {! ..monad} @@ -96,17 +97,17 @@ (function (_ [slot value]) (case slot [_ (#.Text key_name)] - (wrap (` [(~ (code.text key_name)) (~ (wrapper value))])) + (in (` [(~ (code.text key_name)) (~ (wrapper value))])) _ (meta.failure "Wrong syntax for JSON object."))) pairs)] - (wrap (list (` (: JSON (#..Object ((~! dictionary.of_list) - (~! text.hash) - (list (~+ pairs'))))))))) + (in (list (` (: JSON (#..Object ((~! dictionary.of_list) + (~! text.hash) + (list (~+ pairs'))))))))) _ - (wrap (list token))))) + (in (list token))))) (def: #export (fields json) {#.doc "Get all the fields in a JSON object."} @@ -187,7 +188,7 @@ (do maybe.monad [x' (row.nth idx xs) y' (row.nth idx ys)] - (wrap (= x' y')))))) + (in (= x' y')))))) #1 (list.indices (row.size xs)))) @@ -305,14 +306,14 @@ (Parser Null) (do <>.monad [_ (<text>.this "null")] - (wrap []))) + (in []))) (template [<name> <token> <value>] [(def: <name> (Parser Boolean) (do <>.monad [_ (<text>.this <token>)] - (wrap <value>)))] + (in <value>)))] [true_parser "true" #1] [false_parser "false" #0] @@ -338,31 +339,31 @@ [mark (<text>.one_of "eE") signed?' (<>.parses? (<text>.this "-")) offset (<text>.many <text>.decimal)] - (wrap ($_ text\compose mark (if signed?' "-" "") offset))))] + (in ($_ text\compose mark (if signed?' "-" "") offset))))] (case (f\decode ($_ text\compose (if signed? "-" "") digits "." decimals exp)) (#try.Failure message) (<>.failure message) (#try.Success value) - (wrap value)))) + (in value)))) (def: escaped_parser (Parser Text) ($_ <>.either (<>.after (<text>.this "\t") - (<>\wrap text.tab)) + (<>\in text.tab)) (<>.after (<text>.this "\b") - (<>\wrap text.back_space)) + (<>\in text.back_space)) (<>.after (<text>.this "\n") - (<>\wrap text.new_line)) + (<>\in text.new_line)) (<>.after (<text>.this "\r") - (<>\wrap text.carriage_return)) + (<>\in text.carriage_return)) (<>.after (<text>.this "\f") - (<>\wrap text.form_feed)) + (<>\in text.form_feed)) (<>.after (<text>.this (text\compose "\" text.double_quote)) - (<>\wrap text.double_quote)) + (<>\in text.double_quote)) (<>.after (<text>.this "\\") - (<>\wrap "\")))) + (<>\in "\")))) (def: string_parser (Parser String) @@ -375,8 +376,8 @@ (do ! [escaped escaped_parser next_chars (recur [])] - (wrap ($_ text\compose chars escaped next_chars))) - (wrap chars)))) + (in ($_ text\compose chars escaped next_chars))) + (in chars)))) (def: (kv_parser json_parser) (-> (Parser JSON) (Parser [String JSON])) @@ -386,7 +387,7 @@ _ (<text>.this ..entry_separator) _ ..space_parser value json_parser] - (wrap [key value]))) + (in [key value]))) (template [<name> <type> <open> <close> <elem_parser> <prep>] [(def: (<name> json_parser) @@ -397,7 +398,7 @@ elems (<>.separated_by ..separator_parser <elem_parser>) _ space_parser _ (<text>.this <close>)] - (wrap (<prep> elems))))] + (in (<prep> elems))))] [array_parser Array ..open_array ..close_array json_parser row.of_list] [object_parser Object ..open_object ..close_object (kv_parser json_parser) (dictionary.of_list text.hash)] diff --git a/stdlib/source/library/lux/data/format/tar.lux b/stdlib/source/library/lux/data/format/tar.lux index b4ae34e8a..d216a1ef8 100644 --- a/stdlib/source/library/lux/data/format/tar.lux +++ b/stdlib/source/library/lux/data/format/tar.lux @@ -74,7 +74,7 @@ (-> Nat (Try <type>)) (if (n.< <limit> value) (#try.Success (:abstraction value)) - (exception.throw <exception> [value]))) + (exception.except <exception> [value]))) (def: #export <out> (-> <type> Nat) @@ -123,7 +123,7 @@ _ (let [expected (`` (char (~~ (static ..null))))] (<>.assert (exception.construct ..wrong_character [expected end]) (n.= expected end)))] - (wrap []))) + (in []))) (def: small_parser (Parser Small) @@ -200,8 +200,8 @@ _ ..verify_small_suffix value (<>.lift (\ n.octal decode digits))] - (wrap [value - (:abstraction (format digits ..checksum_suffix))]))) + (in [value + (:abstraction (format digits ..checksum_suffix))]))) ) (def: last_ascii @@ -254,8 +254,8 @@ (if (..ascii? value) (if (|> value (\ utf8.codec encode) binary.size (n.<= <size>)) (#try.Success (:abstraction value)) - (exception.throw <exception> [value])) - (exception.throw ..not_ascii [value]))) + (exception.except <exception> [value])) + (exception.except ..not_ascii [value]))) (def: #export <out> (-> <type> <representation>) @@ -421,12 +421,12 @@ (case (.nat linkflag) (^template [<value> <link_flag>] [(^ <value>) - (wrap <link_flag>)]) + (in <link_flag>)]) (<options>) _ (<>.lift - (exception.throw ..invalid_link_flag [(.nat linkflag)])))))) + (exception.except ..invalid_link_flag [(.nat linkflag)])))))) ) (abstract: #export Mode @@ -506,9 +506,9 @@ [value (\ ! map ..from_small ..small_parser)] (if (n.<= (:representation ..maximum_mode) value) - (wrap (:abstraction value)) + (in (:abstraction value)) (<>.lift - (exception.throw ..invalid_mode [value])))))) + (exception.except ..invalid_mode [value])))))) ) (def: maximum_content_size @@ -524,7 +524,7 @@ (-> Binary (Try Content)) (do try.monad [size (..big (binary.size content))] - (wrap (:abstraction [size content])))) + (in (:abstraction [size content])))) (def: from_content (-> Content [Big Binary]) @@ -773,20 +773,20 @@ major_device ..small_parser minor_device ..small_parser _ (<b>.segment ..header_padding_size)] - (wrap {#path path - #mode mode - #user_id user_id - #group_id group_id - #size size - #modification_time modification_time - #checksum checksum_code - #link_flag link_flag - #link_name link_name - #magic magic - #user_name user_name - #group_name group_name - #major_device major_device - #minor_device minor_device}))) + (in {#path path + #mode mode + #user_id user_id + #group_id group_id + #size size + #modification_time modification_time + #checksum checksum_code + #link_flag link_flag + #link_name link_name + #magic magic + #user_name user_name + #group_name group_name + #major_device major_device + #minor_device minor_device}))) (exception: #export (wrong_link_flag {expected Link_Flag} {actual Link_Flag}) (exception.report @@ -804,20 +804,20 @@ content (<b>.segment (..from_big size)) content (<>.lift (..content content)) _ (<b>.segment (n.- (..from_big size) rounded_size))] - (wrap [(get@ #path header) - (|> header - (get@ #modification_time) - ..from_big - .int - duration.of_millis - (duration.up (|> duration.second duration.to_millis .nat)) - instant.absolute) - (get@ #mode header) - {#user {#name (get@ #user_name header) - #id (get@ #user_id header)} - #group {#name (get@ #group_name header) - #id (get@ #group_id header)}} - content]))) + (in [(get@ #path header) + (|> header + (get@ #modification_time) + ..from_big + .int + duration.of_millis + (duration.up (|> duration.second duration.to_millis .nat)) + instant.absolute) + (get@ #mode header) + {#user {#name (get@ #user_name header) + #id (get@ #user_id header)} + #group {#name (get@ #group_name header) + #id (get@ #group_id header)}} + content]))) (def: (file_name_parser expected extractor) (-> Link_Flag (-> Header Path) (Parser Path)) @@ -827,7 +827,7 @@ (exception.assert ..wrong_link_flag [expected (get@ #link_flag header)] (n.= (..link_flag expected) (..link_flag (get@ #link_flag header)))))] - (wrap (extractor header)))) + (in (extractor header)))) (def: entry_parser (Parser Entry) diff --git a/stdlib/source/library/lux/data/format/xml.lux b/stdlib/source/library/lux/data/format/xml.lux index 7dd861762..468100e5b 100644 --- a/stdlib/source/library/lux/data/format/xml.lux +++ b/stdlib/source/library/lux/data/format/xml.lux @@ -44,11 +44,11 @@ (def: xml_standard_escape_char^ (Parser Text) ($_ <>.either - (<>.after (<text>.this "<") (<>\wrap "<")) - (<>.after (<text>.this ">") (<>\wrap ">")) - (<>.after (<text>.this "&") (<>\wrap "&")) - (<>.after (<text>.this "'") (<>\wrap "'")) - (<>.after (<text>.this """) (<>\wrap text.double_quote)) + (<>.after (<text>.this "<") (<>\in "<")) + (<>.after (<text>.this ">") (<>\in ">")) + (<>.after (<text>.this "&") (<>\in "&")) + (<>.after (<text>.this "'") (<>\in "'")) + (<>.after (<text>.this """) (<>\in text.double_quote)) )) (def: xml_unicode_escape_char^ @@ -61,7 +61,7 @@ (#.Some _) (<>.codec int.decimal (<text>.many <text>.hexadecimal)))] - (wrap (|> code .nat text.of_code))) + (in (|> code .nat text.of_code))) (<>.before (<text>.this ";")) (<>.after (<text>.this "&#")))) @@ -82,7 +82,7 @@ <text>.alpha) tail (<text>.some (<>.either (<text>.one_of "_.-") <text>.alpha_num))] - (wrap ($_ text\compose head tail)))) + (in ($_ text\compose head tail)))) (def: namespaced_symbol^ (Parser Name) @@ -91,10 +91,10 @@ ?second_part (<| <>.maybe (<>.after (<text>.this ..namespace_separator)) xml_identifier)] (case ?second_part #.None - (wrap ["" first_part]) + (in ["" first_part]) (#.Some second_part) - (wrap [first_part second_part])))) + (in [first_part second_part])))) (def: tag^ namespaced_symbol^) (def: attr_name^ namespaced_symbol^) @@ -174,18 +174,18 @@ #let [no_children^ ($_ <>.either (do <>.monad [_ (<text>.this "/>")] - (wrap (#Node tag attrs (list)))) + (in (#Node tag attrs (list)))) (do <>.monad [_ (<text>.this ">") _ (<>.some (<>.either <text>.space ..comment^)) _ (..close_tag^ tag)] - (wrap (#Node tag attrs (list))))) + (in (#Node tag attrs (list))))) with_children^ (do <>.monad [_ (<text>.this ">") children (<>.many node^) _ (..close_tag^ tag)] - (wrap (#Node tag attrs children)))]] + (in (#Node tag attrs children)))]] ($_ <>.either no_children^ with_children^)) diff --git a/stdlib/source/library/lux/data/identity.lux b/stdlib/source/library/lux/data/identity.lux index c0a39ab5e..521f66e3e 100644 --- a/stdlib/source/library/lux/data/identity.lux +++ b/stdlib/source/library/lux/data/identity.lux @@ -27,12 +27,12 @@ (Monad Identity) (def: &functor ..functor) - (def: wrap function.identity) + (def: in function.identity) (def: join function.identity)) (implementation: #export comonad (CoMonad Identity) (def: &functor ..functor) - (def: unwrap function.identity) + (def: out function.identity) (def: split function.identity)) diff --git a/stdlib/source/library/lux/data/lazy.lux b/stdlib/source/library/lux/data/lazy.lux index c9a6ae18c..016a5a18a 100644 --- a/stdlib/source/library/lux/data/lazy.lux +++ b/stdlib/source/library/lux/data/lazy.lux @@ -39,7 +39,7 @@ (syntax: #export (freeze expr) (with_gensyms [g!_] - (wrap (list (` ((~! freeze') (function ((~ g!_) (~ g!_)) (~ expr)))))))) + (in (list (` ((~! freeze') (function ((~ g!_) (~ g!_)) (~ expr)))))))) (implementation: #export (equivalence (^open "_\.")) (All [a] (-> (Equivalence a) (Equivalence (Lazy a)))) @@ -64,5 +64,5 @@ (Monad Lazy) (def: &functor ..functor) - (def: wrap (|>> freeze)) + (def: in (|>> freeze)) (def: join thaw)) diff --git a/stdlib/source/library/lux/data/maybe.lux b/stdlib/source/library/lux/data/maybe.lux index ed6a875ce..d51bfed90 100644 --- a/stdlib/source/library/lux/data/maybe.lux +++ b/stdlib/source/library/lux/data/maybe.lux @@ -54,7 +54,7 @@ (def: &functor ..functor) - (def: (wrap x) + (def: (in x) (#.Some x)) (def: (join mma) @@ -98,21 +98,21 @@ (def: &functor (functor.compose (get@ #monad.&functor monad) ..functor)) - (def: wrap (|>> (\ ..monad wrap) (\ monad wrap))) + (def: in (|>> (\ ..monad in) (\ monad in))) (def: (join MmMma) (do monad [mMma MmMma] (case mMma #.None - (wrap #.None) + (in #.None) (#.Some Mma) Mma)))) (def: #export (lift monad) (All [M a] (-> (Monad M) (-> (M a) (M (Maybe a))))) - (\ monad map (\ ..monad wrap))) + (\ monad map (\ ..monad in))) (macro: #export (default tokens state) {#.doc (doc "Allows you to provide a default value that will be used" diff --git a/stdlib/source/library/lux/data/store.lux b/stdlib/source/library/lux/data/store.lux index 3a6d73386..ecc34fde5 100644 --- a/stdlib/source/library/lux/data/store.lux +++ b/stdlib/source/library/lux/data/store.lux @@ -29,7 +29,7 @@ (def: &functor ..functor) - (def: (unwrap wa) (\\ peek (\\ cursor))) + (def: (out wa) (\\ peek (\\ cursor))) (def: split (extend id))) diff --git a/stdlib/source/library/lux/data/text.lux b/stdlib/source/library/lux/data/text.lux index 7dfebd734..15dd8ec04 100644 --- a/stdlib/source/library/lux/data/text.lux +++ b/stdlib/source/library/lux/data/text.lux @@ -172,7 +172,7 @@ [index (index_of token sample) [pre post'] (split index sample) [_ post] (split (size token) post')] - (wrap [pre post]))) + (in [pre post]))) (def: #export (split_all_with token sample) (-> Text Text (List Text)) @@ -194,7 +194,7 @@ (<| (maybe.default template) (do maybe.monad [[pre post] (..split_with pattern template)] - (wrap ($_ "lux text concat" pre replacement post))))) + (in ($_ "lux text concat" pre replacement post))))) (def: #export (replace_all pattern replacement template) (-> Text Text Text Text) diff --git a/stdlib/source/library/lux/data/text/escape.lux b/stdlib/source/library/lux/data/text/escape.lux index 08724a881..9ca9ecfe1 100644 --- a/stdlib/source/library/lux/data/text/escape.lux +++ b/stdlib/source/library/lux/data/text/escape.lux @@ -188,7 +188,7 @@ limit'])) (#try.Failure error) - (exception.throw ..invalid_unicode_escape [current offset]))) + (exception.except ..invalid_unicode_escape [current offset]))) (def: #export (un_escape text) (-> Text (Try Text)) @@ -223,11 +223,11 @@ (do try.monad [[previous' current' limit'] (..unicode_un_escape offset previous current limit)] (recur 0 previous' current' limit')) - (exception.throw ..invalid_unicode_escape [text offset]))) + (exception.except ..invalid_unicode_escape [text offset]))) invalid_sigil - (exception.throw ..invalid_escape [text offset invalid_sigil])) - (exception.throw ..dangling_escape [text]))) + (exception.except ..invalid_escape [text offset invalid_sigil])) + (exception.except ..dangling_escape [text]))) _ (recur (inc offset) previous current limit)) @@ -238,7 +238,7 @@ (syntax: #export (escaped {literal <code>.text}) (case (..un_escape literal) (#try.Success un_escaped) - (wrap (list (code.text un_escaped))) + (in (list (code.text un_escaped))) (#try.Failure error) (meta.failure error))) diff --git a/stdlib/source/library/lux/data/text/format.lux b/stdlib/source/library/lux/data/text/format.lux index c1a1478b6..5b59cf98a 100644 --- a/stdlib/source/library/lux/data/text/format.lux +++ b/stdlib/source/library/lux/data/text/format.lux @@ -52,7 +52,7 @@ (syntax: #export (format {fragments (<>.many <c>.any)}) {#.doc (doc "Text interpolation." (format "Static part " (text static) " does not match URI: " uri))} - (wrap (.list (` ($_ "lux text concat" (~+ fragments)))))) + (in (.list (` ($_ "lux text concat" (~+ fragments)))))) (template [<name> <type> <formatter>] [(def: #export <name> diff --git a/stdlib/source/library/lux/data/text/regex.lux b/stdlib/source/library/lux/data/text/regex.lux index c390e1c08..63aca69fb 100644 --- a/stdlib/source/library/lux/data/text/regex.lux +++ b/stdlib/source/library/lux/data/text/regex.lux @@ -40,7 +40,7 @@ (do <>.monad [output base^ _ (<t>.local output refinement^)] - (wrap output))) + (in output))) (def: word^ (Parser Text) @@ -49,13 +49,13 @@ (def: (copy reference) (-> Text (Parser Text)) - (<>.after (<t>.this reference) (<>\wrap reference))) + (<>.after (<t>.this reference) (<>\in reference))) (def: (join_text^ part^) (-> (Parser (List Text)) (Parser Text)) (do <>.monad [parts part^] - (wrap (//.join_with "" parts)))) + (in (//.join_with "" parts)))) (def: name_char^ (Parser Text) @@ -67,21 +67,21 @@ [head (refine^ (<t>.not <t>.decimal) name_char^) tail (<t>.some name_char^)] - (wrap (format head tail)))) + (in (format head tail)))) (def: (name^ current_module) (-> Text (Parser Name)) ($_ <>.either - (<>.and (<>\wrap current_module) (<>.after (<t>.this "..") name_part^)) + (<>.and (<>\in current_module) (<>.after (<t>.this "..") name_part^)) (<>.and name_part^ (<>.after (<t>.this ".") name_part^)) - (<>.and (<>\wrap .prelude_module) (<>.after (<t>.this ".") name_part^)) - (<>.and (<>\wrap "") name_part^))) + (<>.and (<>\in .prelude_module) (<>.after (<t>.this ".") name_part^)) + (<>.and (<>\in "") name_part^))) (def: (re_var^ current_module) (-> Text (Parser Code)) (do <>.monad [name (<t>.enclosed ["\@<" ">"] (name^ current_module))] - (wrap (` (: (Parser Text) (~ (code.identifier name))))))) + (in (` (: (Parser Text) (~ (code.identifier name))))))) (def: re_range^ (Parser Code) @@ -89,19 +89,19 @@ [from (|> regex_char^ (\ ! map (|>> (//.nth 0) maybe.assume))) _ (<t>.this "-") to (|> regex_char^ (\ ! map (|>> (//.nth 0) maybe.assume)))] - (wrap (` (<t>.range (~ (code.nat from)) (~ (code.nat to))))))) + (in (` (<t>.range (~ (code.nat from)) (~ (code.nat to))))))) (def: re_char^ (Parser Code) (do <>.monad [char escaped_char^] - (wrap (` ((~! ..copy) (~ (code.text char))))))) + (in (` ((~! ..copy) (~ (code.text char))))))) (def: re_options^ (Parser Code) (do <>.monad [options (<t>.many escaped_char^)] - (wrap (` (<t>.one_of (~ (code.text options))))))) + (in (` (<t>.one_of (~ (code.text options))))))) (def: re_user_class^' (Parser Code) @@ -110,20 +110,20 @@ parts (<>.many ($_ <>.either re_range^ re_options^))] - (wrap (case negate? - (#.Some _) (` (<t>.not ($_ <>.either (~+ parts)))) - #.None (` ($_ <>.either (~+ parts))))))) + (in (case negate? + (#.Some _) (` (<t>.not ($_ <>.either (~+ parts)))) + #.None (` ($_ <>.either (~+ parts))))))) (def: re_user_class^ (Parser Code) (do <>.monad - [_ (wrap []) + [_ (in []) init re_user_class^' rest (<>.some (<>.after (<t>.this "&&") (<t>.enclosed ["[" "]"] re_user_class^')))] - (wrap (list\fold (function (_ refinement base) - (` ((~! refine^) (~ refinement) (~ base)))) - init - rest)))) + (in (list\fold (function (_ refinement base) + (` ((~! refine^) (~ refinement) (~ base)))) + init + rest)))) (def: blank^ (Parser Text) @@ -157,28 +157,28 @@ (do <>.monad [] ($_ <>.either - (<>.after (<t>.this ".") (wrap (` <t>.any))) - (<>.after (<t>.this "\d") (wrap (` <t>.decimal))) - (<>.after (<t>.this "\D") (wrap (` (<t>.not <t>.decimal)))) - (<>.after (<t>.this "\s") (wrap (` <t>.space))) - (<>.after (<t>.this "\S") (wrap (` (<t>.not <t>.space)))) - (<>.after (<t>.this "\w") (wrap (` (~! word^)))) - (<>.after (<t>.this "\W") (wrap (` (<t>.not (~! word^))))) - - (<>.after (<t>.this "\p{Lower}") (wrap (` <t>.lower))) - (<>.after (<t>.this "\p{Upper}") (wrap (` <t>.upper))) - (<>.after (<t>.this "\p{Alpha}") (wrap (` <t>.alpha))) - (<>.after (<t>.this "\p{Digit}") (wrap (` <t>.decimal))) - (<>.after (<t>.this "\p{Alnum}") (wrap (` <t>.alpha_num))) - (<>.after (<t>.this "\p{Space}") (wrap (` <t>.space))) - (<>.after (<t>.this "\p{HexDigit}") (wrap (` <t>.hexadecimal))) - (<>.after (<t>.this "\p{OctDigit}") (wrap (` <t>.octal))) - (<>.after (<t>.this "\p{Blank}") (wrap (` (~! blank^)))) - (<>.after (<t>.this "\p{ASCII}") (wrap (` (~! ascii^)))) - (<>.after (<t>.this "\p{Contrl}") (wrap (` (~! control^)))) - (<>.after (<t>.this "\p{Punct}") (wrap (` (~! punct^)))) - (<>.after (<t>.this "\p{Graph}") (wrap (` (~! graph^)))) - (<>.after (<t>.this "\p{Print}") (wrap (` (~! print^)))) + (<>.after (<t>.this ".") (in (` <t>.any))) + (<>.after (<t>.this "\d") (in (` <t>.decimal))) + (<>.after (<t>.this "\D") (in (` (<t>.not <t>.decimal)))) + (<>.after (<t>.this "\s") (in (` <t>.space))) + (<>.after (<t>.this "\S") (in (` (<t>.not <t>.space)))) + (<>.after (<t>.this "\w") (in (` (~! word^)))) + (<>.after (<t>.this "\W") (in (` (<t>.not (~! word^))))) + + (<>.after (<t>.this "\p{Lower}") (in (` <t>.lower))) + (<>.after (<t>.this "\p{Upper}") (in (` <t>.upper))) + (<>.after (<t>.this "\p{Alpha}") (in (` <t>.alpha))) + (<>.after (<t>.this "\p{Digit}") (in (` <t>.decimal))) + (<>.after (<t>.this "\p{Alnum}") (in (` <t>.alpha_num))) + (<>.after (<t>.this "\p{Space}") (in (` <t>.space))) + (<>.after (<t>.this "\p{HexDigit}") (in (` <t>.hexadecimal))) + (<>.after (<t>.this "\p{OctDigit}") (in (` <t>.octal))) + (<>.after (<t>.this "\p{Blank}") (in (` (~! blank^)))) + (<>.after (<t>.this "\p{ASCII}") (in (` (~! ascii^)))) + (<>.after (<t>.this "\p{Contrl}") (in (` (~! control^)))) + (<>.after (<t>.this "\p{Punct}") (in (` (~! punct^)))) + (<>.after (<t>.this "\p{Graph}") (in (` (~! graph^)))) + (<>.after (<t>.this "\p{Print}") (in (` (~! print^)))) ))) (def: re_class^ @@ -196,12 +196,12 @@ (<>.either (do <>.monad [_ (<t>.this "\") id number^] - (wrap (` ((~! ..copy) (~ (code.identifier ["" (n\encode id)])))))) + (in (` ((~! ..copy) (~ (code.identifier ["" (n\encode id)])))))) (do <>.monad [_ (<t>.this "\k<") captured_name name_part^ _ (<t>.this ">")] - (wrap (` ((~! ..copy) (~ (code.identifier ["" captured_name])))))))) + (in (` ((~! ..copy) (~ (code.identifier ["" captured_name])))))))) (def: (re_simple^ current_module) (-> Text (Parser Code)) @@ -219,14 +219,14 @@ quantifier (<t>.one_of "?*+")] (case quantifier "?" - (wrap (` (<>.default "" (~ base)))) + (in (` (<>.default "" (~ base)))) "*" - (wrap (` ((~! join_text^) (<>.some (~ base))))) + (in (` ((~! join_text^) (<>.some (~ base))))) ## "+" _ - (wrap (` ((~! join_text^) (<>.many (~ base))))) + (in (` ((~! join_text^) (<>.many (~ base))))) ))) (def: (re_counted_quantified^ current_module) @@ -237,18 +237,18 @@ ($_ <>.either (do ! [[from to] (<>.and number^ (<>.after (<t>.this ",") number^))] - (wrap (` ((~! join_text^) (<>.between (~ (code.nat from)) - (~ (code.nat to)) - (~ base)))))) + (in (` ((~! join_text^) (<>.between (~ (code.nat from)) + (~ (code.nat to)) + (~ base)))))) (do ! [limit (<>.after (<t>.this ",") number^)] - (wrap (` ((~! join_text^) (<>.at_most (~ (code.nat limit)) (~ base)))))) + (in (` ((~! join_text^) (<>.at_most (~ (code.nat limit)) (~ base)))))) (do ! [limit (<>.before (<t>.this ",") number^)] - (wrap (` ((~! join_text^) (<>.at_least (~ (code.nat limit)) (~ base)))))) + (in (` ((~! join_text^) (<>.at_least (~ (code.nat limit)) (~ base)))))) (do ! [limit number^] - (wrap (` ((~! join_text^) (<>.exactly (~ (code.nat limit)) (~ base)))))))))) + (in (` ((~! join_text^) (<>.exactly (~ (code.nat limit)) (~ base)))))))))) (def: (re_quantified^ current_module) (-> Text (Parser Code)) @@ -307,18 +307,18 @@ (: (List Code) (list)) (: (List (List Code)) (list))] parts)]] - (wrap [(if capturing? - (list.size names) - 0) - (` (do <>.monad - [(~ (' #let)) [(~ g!total) ""] - (~+ (|> steps list.reverse list\join))] - ((~ (' wrap)) [(~ g!total) (~+ (list.reverse names))])))]) + (in [(if capturing? + (list.size names) + 0) + (` (do <>.monad + [(~ (' #let)) [(~ g!total) ""] + (~+ (|> steps list.reverse list\join))] + ((~ (' in)) [(~ g!total) (~+ (list.reverse names))])))]) )) (def: (unflatten^ lexer) (-> (Parser Text) (Parser [Text Any])) - (<>.and lexer (\ <>.monad wrap []))) + (<>.and lexer (\ <>.monad in []))) (def: (|||^ left right) (All [l r] (-> (Parser [Text l]) (Parser [Text r]) (Parser [Text (| l r)]))) @@ -366,13 +366,13 @@ head sub^ tail (<>.some (<>.after (<t>.this "|") sub^))] (if (list.empty? tail) - (wrap head) - (wrap [(list\fold n.max (product.left head) (list\map product.left tail)) - (` ($_ ((~ (if capturing? - (` (~! |||^)) - (` (~! |||_^))))) - (~ (prep_alternative head)) - (~+ (list\map prep_alternative tail))))])))) + (in head) + (in [(list\fold n.max (product.left head) (list\map product.left tail)) + (` ($_ ((~ (if capturing? + (` (~! |||^)) + (` (~! |||_^))))) + (~ (prep_alternative head)) + (~+ (list\map prep_alternative tail))))])))) (def: (re_scoped^ current_module) (-> Text (Parser [Re_Group Code])) @@ -381,22 +381,22 @@ [_ (<t>.this "(?:") [_ scoped] (re_alternative^ #0 re_scoped^ current_module) _ (<t>.this ")")] - (wrap [#Non_Capturing scoped])) + (in [#Non_Capturing scoped])) (do <>.monad [complex (re_complex^ current_module)] - (wrap [#Non_Capturing complex])) + (in [#Non_Capturing complex])) (do <>.monad [_ (<t>.this "(?<") captured_name name_part^ _ (<t>.this ">") [num_captures pattern] (re_alternative^ #1 re_scoped^ current_module) _ (<t>.this ")")] - (wrap [(#Capturing [(#.Some captured_name) num_captures]) pattern])) + (in [(#Capturing [(#.Some captured_name) num_captures]) pattern])) (do <>.monad [_ (<t>.this "(") [num_captures pattern] (re_alternative^ #1 re_scoped^ current_module) _ (<t>.this ")")] - (wrap [(#Capturing [#.None num_captures]) pattern])))) + (in [(#Capturing [#.None num_captures]) pattern])))) (def: (regex^ current_module) (-> Text (Parser Code)) @@ -470,7 +470,7 @@ error)) (#try.Success regex) - (wrap (list regex)) + (in (list regex)) ))) (syntax: #export (^regex {[pattern bindings] (<c>.form (<>.and <c>.text (<>.maybe <c>.any)))} @@ -488,8 +488,8 @@ _ do_something_else))} (with_gensyms [g!temp] - (wrap (list& (` (^multi (~ g!temp) - {((~! <t>.run) (..regex (~ (code.text pattern))) (~ g!temp)) - (#try.Success (~ (maybe.default g!temp bindings)))})) - body - branches)))) + (in (list& (` (^multi (~ g!temp) + {((~! <t>.run) (..regex (~ (code.text pattern))) (~ g!temp)) + (#try.Success (~ (maybe.default g!temp bindings)))})) + body + branches)))) diff --git a/stdlib/source/library/lux/data/trace.lux b/stdlib/source/library/lux/data/trace.lux index 0edcff430..9646fa0f3 100644 --- a/stdlib/source/library/lux/data/trace.lux +++ b/stdlib/source/library/lux/data/trace.lux @@ -18,7 +18,7 @@ (implementation: #export comonad (All [t] (CoMonad (Trace t))) (def: &functor ..functor) - (def: (unwrap wa) + (def: (out wa) ((get@ #trace wa) (get@ [#monoid #monoid.identity] wa))) diff --git a/stdlib/source/library/lux/debug.lux b/stdlib/source/library/lux/debug.lux index 4ca51d344..c57394dd3 100644 --- a/stdlib/source/library/lux/debug.lux +++ b/stdlib/source/library/lux/debug.lux @@ -390,12 +390,12 @@ (`` ($_ <>.either (do <>.monad [_ (<type>.exactly Any)] - (wrap (function.constant "[]"))) + (in (function.constant "[]"))) (~~ (template [<type> <formatter>] [(do <>.monad [_ (<type>.sub <type>)] - (wrap (|>> (:as <type>) <formatter>)))] + (in (|>> (:as <type>) <formatter>)))] [Bit %.bit] [Nat %.nat] @@ -411,7 +411,7 @@ (~~ (template [<type> <formatter>] [(do <>.monad [_ (<type>.sub <type>)] - (wrap (|>> (:as <type>) <formatter>)))] + (in (|>> (:as <type>) <formatter>)))] [Ratio %.ratio] [Name %.name] @@ -432,58 +432,58 @@ (do <>.monad [[_ elemT] (<type>.applied (<>.and (<type>.exactly List) <type>.any)) elemR (<type>.local (list elemT) representation)] - (wrap (|>> (:as (List Any)) (%.list elemR)))) + (in (|>> (:as (List Any)) (%.list elemR)))) (do <>.monad [[_ elemT] (<type>.applied (<>.and (<type>.exactly Maybe) <type>.any)) elemR (<type>.local (list elemT) representation)] - (wrap (|>> (:as (Maybe Any)) - (%.maybe elemR))))))) + (in (|>> (:as (Maybe Any)) + (%.maybe elemR))))))) (def: (variant_representation representation) (-> (Parser Representation) (Parser Representation)) (do <>.monad [membersR+ (<type>.variant (<>.many representation))] - (wrap (function (_ variantV) - (let [[lefts right? sub_repr] (loop [lefts 0 - representations membersR+ - variantV variantV] - (case representations - (#.Cons leftR (#.Cons rightR extraR+)) - (case (:as (| Any Any) variantV) - (#.Left left) - [lefts #0 (leftR left)] - - (#.Right right) - (case extraR+ - #.Nil - [lefts #1 (rightR right)] - - _ - (recur (inc lefts) (#.Cons rightR extraR+) right))) - - _ - (undefined)))] - (%.format "(" (%.nat lefts) " " (%.bit right?) " " sub_repr ")")))))) + (in (function (_ variantV) + (let [[lefts right? sub_repr] (loop [lefts 0 + representations membersR+ + variantV variantV] + (case representations + (#.Cons leftR (#.Cons rightR extraR+)) + (case (:as (| Any Any) variantV) + (#.Left left) + [lefts #0 (leftR left)] + + (#.Right right) + (case extraR+ + #.Nil + [lefts #1 (rightR right)] + + _ + (recur (inc lefts) (#.Cons rightR extraR+) right))) + + _ + (undefined)))] + (%.format "(" (%.nat lefts) " " (%.bit right?) " " sub_repr ")")))))) (def: (tuple_representation representation) (-> (Parser Representation) (Parser Representation)) (do <>.monad [membersR+ (<type>.tuple (<>.many representation))] - (wrap (function (_ tupleV) - (let [tuple_body (loop [representations membersR+ - tupleV tupleV] - (case representations - #.Nil - "" - - (#.Cons lastR #.Nil) - (lastR tupleV) - - (#.Cons headR tailR) - (let [[leftV rightV] (:as [Any Any] tupleV)] - (%.format (headR leftV) " " (recur tailR rightV)))))] - (%.format "[" tuple_body "]")))))) + (in (function (_ tupleV) + (let [tuple_body (loop [representations membersR+ + tupleV tupleV] + (case representations + #.Nil + "" + + (#.Cons lastR #.Nil) + (lastR tupleV) + + (#.Cons headR tailR) + (let [[leftV rightV] (:as [Any Any] tupleV)] + (%.format (headR leftV) " " (recur tailR rightV)))))] + (%.format "[" tuple_body "]")))))) (def: representation_parser (Parser Representation) @@ -518,13 +518,13 @@ (#try.Success (representation value)) (#try.Failure _) - (exception.throw ..cannot_represent_value type))) + (exception.except ..cannot_represent_value type))) (syntax: #export (private {definition <code>.identifier}) (let [[module _] definition] - (wrap (list (` ("lux in-module" - (~ (code.text module)) - (~ (code.identifier definition)))))))) + (in (list (` ("lux in-module" + (~ (code.text module)) + (~ (code.identifier definition)))))))) (def: #export (log! message) {#.doc "Logs message to standard output."} @@ -540,7 +540,7 @@ (do meta.monad [location meta.location expectedT meta.expected_type] - (function.constant (exception.throw ..type_hole [location expectedT])))) + (function.constant (exception.except ..type_hole [location expectedT])))) (type: Target [Text (Maybe Code)]) @@ -548,7 +548,7 @@ (def: target (<code>.Parser Target) (<>.either (<>.and <code>.local_identifier - (\ <>.monad wrap #.None)) + (\ <>.monad in #.None)) (<code>.record (<>.and <code>.local_identifier (\ <>.monad map (|>> #.Some) <code>.any))))) @@ -575,24 +575,24 @@ (|> environment dictionary.keys (list\map (function (_ local) [local #.None])) - wrap) + in) _ (monad.map ! (function (_ [name format]) (if (dictionary.key? environment name) - (wrap [name format]) - (function.constant (exception.throw ..unknown_local_binding [name])))) + (in [name format]) + (function.constant (exception.except ..unknown_local_binding [name])))) targets)))] - (wrap (list (` (..log! ("lux text concat" - (~ (code.text (%.format (%.location location) text.new_line))) - ((~! exception.report) - (~+ (list\map (function (_ [name format]) - (let [format (case format - #.None - (` (~! ..inspection)) - - (#.Some format) - format)] - (` [(~ (code.text name)) - ((~ format) (~ (code.local_identifier name)))]))) - targets)))))))))) + (in (list (` (..log! ("lux text concat" + (~ (code.text (%.format (%.location location) text.new_line))) + ((~! exception.report) + (~+ (list\map (function (_ [name format]) + (let [format (case format + #.None + (` (~! ..inspection)) + + (#.Some format) + format)] + (` [(~ (code.text name)) + ((~ format) (~ (code.local_identifier name)))]))) + targets)))))))))) diff --git a/stdlib/source/library/lux/extension.lux b/stdlib/source/library/lux/extension.lux index 23be093ac..add1ec871 100644 --- a/stdlib/source/library/lux/extension.lux +++ b/stdlib/source/library/lux/extension.lux @@ -27,7 +27,7 @@ (-> Code (Parser Input)) ($_ <>.and <c>.local_identifier - (<>\wrap default))) + (<>\in default))) (def: complex (Parser Input) @@ -70,17 +70,17 @@ g!phase (code.local_identifier phase) g!archive (code.local_identifier archive)] (with_gensyms [g!handler g!inputs g!error] - (wrap (list (` (<extension> (~ name) - (.function ((~ g!handler) (~ g!name) (~ g!phase) (~ g!archive) (~ g!inputs)) - (.case ((~! <run>) (~ g!parser) (~ g!inputs)) - (#.Right [(~+ (list\map (|>> product.left - code.local_identifier) - inputs))]) - (~ body) + (in (list (` (<extension> (~ name) + (.function ((~ g!handler) (~ g!name) (~ g!phase) (~ g!archive) (~ g!inputs)) + (.case ((~! <run>) (~ g!parser) (~ g!inputs)) + (#.Right [(~+ (list\map (|>> product.left + code.local_identifier) + inputs))]) + (~ body) - (#.Left (~ g!error)) - ((~! phase.failure) (~ g!error))) - ))))))))] + (#.Left (~ g!error)) + ((~! phase.failure) (~ g!error))) + ))))))))] [<c>.any <c>.end! <c>.and <c>.run "lux def analysis" analysis:] [<a>.any <a>.end! <a>.and <a>.run "lux def synthesis" synthesis:] diff --git a/stdlib/source/library/lux/ffi.js.lux b/stdlib/source/library/lux/ffi.js.lux index 852ed2b11..629d2f4f5 100644 --- a/stdlib/source/library/lux/ffi.js.lux +++ b/stdlib/source/library/lux/ffi.js.lux @@ -179,7 +179,7 @@ (def: class_declaration (Parser Class_Declaration) (<>.either (<>.and <code>.local_identifier - (<>\wrap (list))) + (<>\in (list))) (<code>.form (<>.and <code>.local_identifier (<>.some <code>.local_identifier))))) @@ -247,76 +247,76 @@ declaration (` ((~ (code.local_identifier class_name)) (~+ class_parameters))) real_class (text.replace_all "/" "." class_name)] - (wrap (list& (` (type: (~ declaration) - (..Object (primitive (~ (code.text real_class)))))) - (list\map (function (_ member) - (case member - (#Constructor inputsT) - (let [g!inputs (input_variables inputsT)] - (` (def: ((~ (qualify "new")) - [(~+ (list\map product.right g!inputs))]) - (All [(~+ class_parameters)] - (-> [(~+ (list\map nullable_type inputsT))] - (~ declaration))) - (:assume - ("js object new" - ("js constant" (~ (code.text real_class))) - [(~+ (list\map (with_null g!temp) g!inputs))]))))) + (in (list& (` (type: (~ declaration) + (..Object (primitive (~ (code.text real_class)))))) + (list\map (function (_ member) + (case member + (#Constructor inputsT) + (let [g!inputs (input_variables inputsT)] + (` (def: ((~ (qualify "new")) + [(~+ (list\map product.right g!inputs))]) + (All [(~+ class_parameters)] + (-> [(~+ (list\map nullable_type inputsT))] + (~ declaration))) + (:assume + ("js object new" + ("js constant" (~ (code.text real_class))) + [(~+ (list\map (with_null g!temp) g!inputs))]))))) + + (#Field [static? field fieldT]) + (if static? + (` ((~! syntax:) ((~ (qualify field))) + (\ (~! meta.monad) (~' in) + (list (` (.:as (~ (nullable_type fieldT)) + ("js constant" (~ (code.text (%.format real_class "." field)))))))))) + (` (def: ((~ (qualify field)) + (~ g!object)) + (All [(~+ class_parameters)] + (-> (~ declaration) + (~ (nullable_type fieldT)))) + (:assume + (~ (without_null g!temp fieldT (` ("js object get" (~ (code.text field)) (~ g!object))))))))) + + (#Method method) + (case method + (#Static [method alias inputsT io? try? outputT]) + (..make_function (qualify (maybe.default method alias)) + g!temp + (%.format real_class "." method) + inputsT + io? + try? + outputT) - (#Field [static? field fieldT]) - (if static? - (` ((~! syntax:) ((~ (qualify field))) - (\ (~! meta.monad) (~' wrap) - (list (` (.:as (~ (nullable_type fieldT)) - ("js constant" (~ (code.text (%.format real_class "." field)))))))))) - (` (def: ((~ (qualify field)) + (#Virtual [method alias inputsT io? try? outputT]) + (let [g!inputs (input_variables inputsT)] + (` (def: ((~ (qualify (maybe.default method alias))) + [(~+ (list\map product.right g!inputs))] (~ g!object)) (All [(~+ class_parameters)] - (-> (~ declaration) - (~ (nullable_type fieldT)))) + (-> [(~+ (list\map nullable_type inputsT))] + (~ declaration) + (~ (|> (nullable_type outputT) + (try_type try?) + (io_type io?))))) (:assume - (~ (without_null g!temp fieldT (` ("js object get" (~ (code.text field)) (~ g!object))))))))) - - (#Method method) - (case method - (#Static [method alias inputsT io? try? outputT]) - (..make_function (qualify (maybe.default method alias)) - g!temp - (%.format real_class "." method) - inputsT - io? - try? - outputT) - - (#Virtual [method alias inputsT io? try? outputT]) - (let [g!inputs (input_variables inputsT)] - (` (def: ((~ (qualify (maybe.default method alias))) - [(~+ (list\map product.right g!inputs))] - (~ g!object)) - (All [(~+ class_parameters)] - (-> [(~+ (list\map nullable_type inputsT))] - (~ declaration) - (~ (|> (nullable_type outputT) - (try_type try?) - (io_type io?))))) - (:assume - (~ (<| (with_io io?) - (with_try try?) - (without_null g!temp outputT) - (` ("js object do" - (~ (code.text method)) - (~ g!object) - [(~+ (list\map (with_null g!temp) g!inputs))]))))))))))) - members))))) + (~ (<| (with_io io?) + (with_try try?) + (without_null g!temp outputT) + (` ("js object do" + (~ (code.text method)) + (~ g!object) + [(~+ (list\map (with_null g!temp) g!inputs))]))))))))))) + members))))) (#Function [name alias inputsT io? try? outputT]) - (wrap (list (..make_function (code.local_identifier (maybe.default name alias)) - g!temp - name - inputsT - io? - try? - outputT))) + (in (list (..make_function (code.local_identifier (maybe.default name alias)) + g!temp + name + inputsT + io? + try? + outputT))) ))) (template: #export (type_of object) @@ -328,24 +328,24 @@ (let [constant (` ("js constant" (~ (code.text head))))] (case tail #.Nil - (wrap (list (` (: (.Maybe (~ type)) + (in (list (` (: (.Maybe (~ type)) + (case (..type_of (~ constant)) + "undefined" + #.None + + (~ g!_) + (#.Some (:as (~ type) (~ constant)))))))) + + (#.Cons [next tail]) + (let [separator "."] + (in (list (` (: (.Maybe (~ type)) (case (..type_of (~ constant)) "undefined" #.None (~ g!_) - (#.Some (:as (~ type) (~ constant)))))))) - - (#.Cons [next tail]) - (let [separator "."] - (wrap (list (` (: (.Maybe (~ type)) - (case (..type_of (~ constant)) - "undefined" - #.None - - (~ g!_) - (..constant (~ type) [(~ (code.local_identifier (%.format head "." next))) - (~+ (list\map code.local_identifier tail))]))))))))))) + (..constant (~ type) [(~ (code.local_identifier (%.format head "." next))) + (~+ (list\map code.local_identifier tail))]))))))))))) (template: (!defined? <constant>) (.case (..constant Any <constant>) diff --git a/stdlib/source/library/lux/ffi.jvm.lux b/stdlib/source/library/lux/ffi.jvm.lux index 76983acd5..ff3215f6a 100644 --- a/stdlib/source/library/lux/ffi.jvm.lux +++ b/stdlib/source/library/lux/ffi.jvm.lux @@ -395,14 +395,14 @@ (do <>.monad [#let [dotted_name (format "::" field_name)] _ (<code>.this! (code.identifier ["" dotted_name]))] - (wrap (get_static_field class_name field_name)))) + (in (get_static_field class_name field_name)))) (def: (make_get_var_parser class_name field_name self_name) (-> Text Text Text (Parser Code)) (do <>.monad [#let [dotted_name (format "::" field_name)] _ (<code>.this! (code.identifier ["" dotted_name]))] - (wrap (get_virtual_field class_name field_name (code.local_identifier self_name))))) + (in (get_virtual_field class_name field_name (code.local_identifier self_name))))) (def: (make_put_var_parser class_name field_name self_name) (-> Text Text Text (Parser Code)) @@ -410,11 +410,11 @@ [#let [dotted_name (format "::" field_name)] [_ _ value] (: (Parser [Any Any Code]) (<code>.form ($_ <>.and (<code>.this! (' :=)) (<code>.this! (code.identifier ["" dotted_name])) <code>.any)))] - (wrap (`' ("jvm member put virtual" - (~ (code.text class_name)) - (~ (code.text field_name)) - (~ value) - (~ (code.local_identifier self_name))))))) + (in (`' ("jvm member put virtual" + (~ (code.text class_name)) + (~ (code.text field_name)) + (~ value) + (~ (code.local_identifier self_name))))))) (def: (pre_walk_replace f input) (-> (-> Code Code) Code Code) @@ -464,10 +464,10 @@ [args (: (Parser (List Code)) (<code>.form (<>.after (<code>.this! (' ::new!)) (<code>.tuple (<>.exactly (list.size arguments) <code>.any)))))] - (wrap (` ("jvm member invoke constructor" (~ (code.text class_name)) - (~+ (|> args - (list.zipped/2 (list\map product.right arguments)) - (list\map ..decorate_input)))))))) + (in (` ("jvm member invoke constructor" (~ (code.text class_name)) + (~+ (|> args + (list.zipped/2 (list\map product.right arguments)) + (list\map ..decorate_input)))))))) (def: (make_static_method_parser class_name method_name arguments) (-> Text Text (List Argument) (Parser Code)) @@ -476,10 +476,10 @@ args (: (Parser (List Code)) (<code>.form (<>.after (<code>.this! (code.identifier ["" dotted_name])) (<code>.tuple (<>.exactly (list.size arguments) <code>.any)))))] - (wrap (` ("jvm member invoke static" (~ (code.text class_name)) (~ (code.text method_name)) - (~+ (|> args - (list.zipped/2 (list\map product.right arguments)) - (list\map ..decorate_input)))))))) + (in (` ("jvm member invoke static" (~ (code.text class_name)) (~ (code.text method_name)) + (~+ (|> args + (list.zipped/2 (list\map product.right arguments)) + (list\map ..decorate_input)))))))) (template [<name> <jvm_op>] [(def: (<name> class_name method_name arguments self_name) @@ -489,11 +489,11 @@ args (: (Parser (List Code)) (<code>.form (<>.after (<code>.this! (code.identifier ["" dotted_name])) (<code>.tuple (<>.exactly (list.size arguments) <code>.any)))))] - (wrap (` (<jvm_op> (~ (code.text class_name)) (~ (code.text method_name)) - (~ (code.local_identifier self_name)) - (~+ (|> args - (list.zipped/2 (list\map product.right arguments)) - (list\map ..decorate_input))))))))] + (in (` (<jvm_op> (~ (code.text class_name)) (~ (code.text method_name)) + (~ (code.local_identifier self_name)) + (~+ (|> args + (list.zipped/2 (list\map product.right arguments)) + (list\map ..decorate_input))))))))] [make_special_method_parser "jvm member invoke special"] [make_virtual_method_parser "jvm member invoke virtual"] @@ -527,7 +527,7 @@ (<code>.this! (' #public)) (<code>.this! (' #private)) (<code>.this! (' #protected)) - (wrap [])))) + (in [])))) (def: inheritance_modifier^ (Parser Inheritance) @@ -535,7 +535,7 @@ ($_ <>.or (<code>.this! (' #final)) (<code>.this! (' #abstract)) - (wrap [])))) + (in [])))) (exception: #export (class_names_cannot_contain_periods {name Text}) (exception.report @@ -562,7 +562,7 @@ (not (list.member? text.equivalence (list\map parser.name type_vars) name)))] - (wrap name))) + (in name))) (def: (class^' parameter^ type_vars) (-> (-> (List (Type Var)) (Parser (Type Parameter))) @@ -571,10 +571,10 @@ [[name parameters] (: (Parser [External (List (Type Parameter))]) ($_ <>.either (<>.and (valid_class_name type_vars) - (<>\wrap (list))) + (<>\in (list))) (<code>.form (<>.and <code>.local_identifier (<>.some (parameter^ type_vars))))))] - (wrap (type.class (name.safe name) parameters)))) + (in (type.class (name.safe name) parameters)))) (exception: #export (unexpected_type_variable {name Text} {type_vars (List (Type Var))}) @@ -588,13 +588,13 @@ [name <code>.local_identifier _ (..assert ..unexpected_type_variable [name type_vars] (list.member? text.equivalence (list\map parser.name type_vars) name))] - (wrap (type.var name)))) + (in (type.var name)))) (def: wildcard^ (Parser (Type Parameter)) (do <>.monad [_ (<code>.this! (' ?))] - (wrap type.wildcard))) + (in type.wildcard))) (template [<name> <comparison> <constructor>] [(def: <name> @@ -627,7 +627,7 @@ (Parser (Type (<| Return' Value' category))))) (do <>.monad [_ (<code>.identifier! ["" (..reflection type)])] - (wrap type))) + (in type))) (def: primitive^ (Parser (Type Primitive)) @@ -661,7 +661,7 @@ (Parser (Type Void)) (do <>.monad [_ (<code>.identifier! ["" (reflection.reflection reflection.void)])] - (wrap type.void))) + (in type.void))) (def: (return^ type_vars) (-> (List (Type Var)) (Parser (Type Return))) @@ -681,11 +681,11 @@ (do <>.monad [[name variables] (: (Parser [External (List (Type Var))]) (<>.either (<>.and (..valid_class_name (list)) - (<>\wrap (list))) + (<>\in (list))) (<code>.form (<>.and (..valid_class_name (list)) (<>.some var^))) ))] - (wrap (type.declaration name variables)))) + (in (type.declaration name variables)))) (def: (class^ type_vars) (-> (List (Type Var)) (Parser (Type Class))) @@ -699,7 +699,7 @@ (Parser Annotation) (<>.either (do <>.monad [ann_name <code>.local_identifier] - (wrap [ann_name (list)])) + (in [ann_name (list)])) (<code>.form (<>.and <code>.local_identifier annotation_parameters^)))) @@ -713,7 +713,7 @@ (Parser (List Annotation)) (do <>.monad [anns?? (<>.maybe ..annotations^')] - (wrap (maybe.default (list) anns??)))) + (in (maybe.default (list) anns??)))) (def: (throws_decl^ type_vars) (-> (List (Type Var)) (Parser (List (Type Class)))) @@ -732,17 +732,17 @@ inputs (<code>.tuple (<>.some (..type^ total_vars))) output (..return^ total_vars) exs (..throws_decl^ total_vars)] - (wrap [[name #PublicP anns] {#method_tvars tvars - #method_inputs inputs - #method_output output - #method_exs exs}])))) + (in [[name #PublicP anns] {#method_tvars tvars + #method_inputs inputs + #method_output output + #method_exs exs}])))) (def: state_modifier^ (Parser State) ($_ <>.or (<code>.this! (' #volatile)) (<code>.this! (' #final)) - (\ <>.monad wrap []))) + (\ <>.monad in []))) (def: (field_decl^ type_vars) (-> (List (Type Var)) (Parser [Member_Declaration FieldDecl])) @@ -752,14 +752,14 @@ anns ..annotations^ type (..type^ type_vars) body <code>.any] - (wrap [[name #PublicP anns] (#ConstantField [type body])]))) + (in [[name #PublicP anns] (#ConstantField [type body])]))) (<code>.form (do <>.monad [pm privacy_modifier^ sm state_modifier^ name <code>.local_identifier anns ..annotations^ type (..type^ type_vars)] - (wrap [[name pm anns] (#VariableField [sm type])]))))) + (in [[name pm anns] (#VariableField [sm type])]))))) (def: (argument^ type_vars) (-> (List (Type Var)) (Parser Argument)) @@ -793,10 +793,10 @@ exs (throws_decl^ total_vars) annotations ..annotations^ body <code>.any] - (wrap [{#member_name constructor_method_name - #member_privacy pm - #member_anns annotations} - (#ConstructorMethod strict_fp? method_vars self_name arguments constructor_args body exs)])))) + (in [{#member_name constructor_method_name + #member_privacy pm + #member_anns annotations} + (#ConstructorMethod strict_fp? method_vars self_name arguments constructor_args body exs)])))) (def: (virtual_method_def^ class_vars) (-> (List (Type Var)) (Parser [Member_Declaration Method_Definition])) @@ -814,10 +814,10 @@ exs (throws_decl^ total_vars) annotations ..annotations^ body <code>.any] - (wrap [{#member_name name - #member_privacy pm - #member_anns annotations} - (#VirtualMethod final? strict_fp? method_vars self_name arguments return_type body exs)])))) + (in [{#member_name name + #member_privacy pm + #member_anns annotations} + (#VirtualMethod final? strict_fp? method_vars self_name arguments return_type body exs)])))) (def: overriden_method_def^ (Parser [Member_Declaration Method_Definition]) @@ -835,10 +835,10 @@ exs (throws_decl^ total_vars) annotations ..annotations^ body <code>.any] - (wrap [{#member_name name - #member_privacy #PublicP - #member_anns annotations} - (#OverridenMethod strict_fp? owner_class method_vars self_name arguments return_type body exs)])))) + (in [{#member_name name + #member_privacy #PublicP + #member_anns annotations} + (#OverridenMethod strict_fp? owner_class method_vars self_name arguments return_type body exs)])))) (def: static_method_def^ (Parser [Member_Declaration Method_Definition]) @@ -854,10 +854,10 @@ exs (throws_decl^ total_vars) annotations ..annotations^ body <code>.any] - (wrap [{#member_name name - #member_privacy pm - #member_anns annotations} - (#StaticMethod strict_fp? method_vars arguments return_type body exs)])))) + (in [{#member_name name + #member_privacy pm + #member_anns annotations} + (#StaticMethod strict_fp? method_vars arguments return_type body exs)])))) (def: abstract_method_def^ (Parser [Member_Declaration Method_Definition]) @@ -871,10 +871,10 @@ return_type (..return^ total_vars) exs (throws_decl^ total_vars) annotations ..annotations^] - (wrap [{#member_name name - #member_privacy pm - #member_anns annotations} - (#AbstractMethod method_vars arguments return_type exs)])))) + (in [{#member_name name + #member_privacy pm + #member_anns annotations} + (#AbstractMethod method_vars arguments return_type exs)])))) (def: native_method_def^ (Parser [Member_Declaration Method_Definition]) @@ -888,10 +888,10 @@ return_type (..return^ total_vars) exs (throws_decl^ total_vars) annotations ..annotations^] - (wrap [{#member_name name - #member_privacy pm - #member_anns annotations} - (#NativeMethod method_vars arguments return_type exs)])))) + (in [{#member_name name + #member_privacy pm + #member_anns annotations} + (#NativeMethod method_vars arguments return_type exs)])))) (def: (method_def^ class_vars) (-> (List (Type Var)) (Parser [Member_Declaration Method_Definition])) @@ -911,10 +911,10 @@ (Parser Class_Kind) (<>.either (do <>.monad [_ (<code>.this! (' #class))] - (wrap #Class)) + (in #Class)) (do <>.monad [_ (<code>.this! (' #interface))] - (wrap #Interface)) + (in #Interface)) )) (def: import_member_alias^ @@ -946,7 +946,7 @@ (<code>.form (do <>.monad [_ (<code>.this! (' #enum)) enum_members (<>.some <code>.local_identifier)] - (wrap (#EnumDecl enum_members)))) + (in (#EnumDecl enum_members)))) (<code>.form (do <>.monad [tvars (<>.default (list) ..vars^) _ (<code>.identifier! ["" "new"]) @@ -955,20 +955,20 @@ ?prim_mode (<>.maybe primitive_mode^) args (..import_member_args^ total_vars) [io? try? maybe?] import_member_return_flags^] - (wrap (#ConstructorDecl [{#import_member_mode (maybe.default #AutoPrM ?prim_mode) - #import_member_alias (maybe.default "new" ?alias) - #import_member_kind #VirtualIMK - #import_member_tvars tvars - #import_member_args args - #import_member_maybe? maybe? - #import_member_try? try? - #import_member_io? io?} - {}])) + (in (#ConstructorDecl [{#import_member_mode (maybe.default #AutoPrM ?prim_mode) + #import_member_alias (maybe.default "new" ?alias) + #import_member_kind #VirtualIMK + #import_member_tvars tvars + #import_member_args args + #import_member_maybe? maybe? + #import_member_try? try? + #import_member_io? io?} + {}])) )) (<code>.form (do <>.monad [kind (: (Parser ImportMethodKind) (<>.or (<code>.tag! ["" "static"]) - (wrap []))) + (in []))) tvars (<>.default (list) ..vars^) name <code>.local_identifier ?alias import_member_alias^ @@ -977,16 +977,16 @@ args (..import_member_args^ total_vars) [io? try? maybe?] import_member_return_flags^ return (..return^ total_vars)] - (wrap (#MethodDecl [{#import_member_mode (maybe.default #AutoPrM ?prim_mode) - #import_member_alias (maybe.default name ?alias) - #import_member_kind kind - #import_member_tvars tvars - #import_member_args args - #import_member_maybe? maybe? - #import_member_try? try? - #import_member_io? io?} - {#import_method_name name - #import_method_return return}])))) + (in (#MethodDecl [{#import_member_mode (maybe.default #AutoPrM ?prim_mode) + #import_member_alias (maybe.default name ?alias) + #import_member_kind kind + #import_member_tvars tvars + #import_member_args args + #import_member_maybe? maybe? + #import_member_try? try? + #import_member_io? io?} + {#import_method_name name + #import_method_return return}])))) (<code>.form (do <>.monad [static? (<>.parses? (<code>.this! (' #static))) name <code>.local_identifier @@ -994,12 +994,12 @@ gtype (..type^ owner_vars) maybe? (<>.parses? (<code>.this! (' #?))) setter? (<>.parses? (<code>.this! (' #!)))] - (wrap (#FieldAccessDecl {#import_field_mode (maybe.default #AutoPrM ?prim_mode) - #import_field_name name - #import_field_static? static? - #import_field_maybe? maybe? - #import_field_setter? setter? - #import_field_type gtype})))) + (in (#FieldAccessDecl {#import_field_mode (maybe.default #AutoPrM ?prim_mode) + #import_field_name name + #import_field_static? static? + #import_field_maybe? maybe? + #import_field_setter? setter? + #import_field_type gtype})))) )) (def: bundle @@ -1136,13 +1136,13 @@ super_replacer (parser->replacer (<code>.form (do <>.monad [_ (<code>.this! (' ::super!)) args (<code>.tuple (<>.exactly (list.size arguments) <code>.any))] - (wrap (` ("jvm member invoke special" - (~ (code.text (product.left (parser.read_class super_class)))) - (~ (code.text name)) - (~ (code.local_identifier self_name)) - (~+ (|> args - (list.zipped/2 (list\map product.right arguments)) - (list\map ..decorate_input)))))))))] + (in (` ("jvm member invoke special" + (~ (code.text (product.left (parser.read_class super_class)))) + (~ (code.text name)) + (~ (code.local_identifier self_name)) + (~+ (|> args + (list.zipped/2 (list\map product.right arguments)) + (list\map ..decorate_input)))))))))] (` ("override" (~ (declaration$ declaration)) (~ (code.text name)) @@ -1248,14 +1248,14 @@ (|> methods (list\map (method->parser fully_qualified_class_name)) (list\fold <>.either (<>.failure ""))))]] - (wrap (list (` ("jvm class" - (~ (declaration$ (type.declaration full_class_name class_vars))) - (~ (class$ super)) - [(~+ (list\map class$ interfaces))] - (~ (inheritance_modifier$ im)) - [(~+ (list\map annotation$ annotations))] - [(~+ (list\map field_decl$ fields))] - [(~+ (list\map (method_def$ fully_qualified_class_name method_parser super fields) methods))])))))) + (in (list (` ("jvm class" + (~ (declaration$ (type.declaration full_class_name class_vars))) + (~ (class$ super)) + [(~+ (list\map class$ interfaces))] + (~ (inheritance_modifier$ im)) + [(~+ (list\map annotation$ annotations))] + [(~+ (list\map field_decl$ fields))] + [(~+ (list\map (method_def$ fully_qualified_class_name method_parser super fields) methods))])))))) (syntax: #export (interface: {#let [! <>.monad]} @@ -1267,11 +1267,11 @@ {#.doc (doc "Allows defining JVM interfaces." (interface: TestInterface ([] foo [boolean String] void #throws [Exception])))} - (wrap (list (` ("jvm class interface" - (~ (declaration$ (type.declaration full_class_name class_vars))) - [(~+ (list\map class$ supers))] - [(~+ (list\map annotation$ annotations))] - (~+ (list\map method_decl$ members))))))) + (in (list (` ("jvm class interface" + (~ (declaration$ (type.declaration full_class_name class_vars))) + [(~+ (list\map class$ supers))] + [(~+ (list\map annotation$ annotations))] + (~+ (list\map method_decl$ members))))))) (syntax: #export (object {class_vars ..vars^} @@ -1292,17 +1292,17 @@ (exec (do_something some_value) []))) )} - (wrap (list (` ("jvm class anonymous" - [(~+ (list\map var$ class_vars))] - (~ (class$ super)) - [(~+ (list\map class$ interfaces))] - [(~+ (list\map constructor_arg$ constructor_args))] - [(~+ (list\map (method_def$ "" (<>.failure "") super (list)) methods))]))))) + (in (list (` ("jvm class anonymous" + [(~+ (list\map var$ class_vars))] + (~ (class$ super)) + [(~+ (list\map class$ interfaces))] + [(~+ (list\map constructor_arg$ constructor_args))] + [(~+ (list\map (method_def$ "" (<>.failure "") super (list)) methods))]))))) (syntax: #export (null) {#.doc (doc "Null object reference." (null))} - (wrap (list (` ("jvm object null"))))) + (in (list (` ("jvm object null"))))) (def: #export (null? obj) {#.doc (doc "Test for null object reference." @@ -1320,10 +1320,10 @@ (= (??? "YOLO") (#.Some "YOLO")))} (with_gensyms [g!temp] - (wrap (list (` (let [(~ g!temp) (~ expr)] - (if ("jvm object null?" (~ g!temp)) - #.None - (#.Some (~ g!temp))))))))) + (in (list (` (let [(~ g!temp) (~ expr)] + (if ("jvm object null?" (~ g!temp)) + #.None + (#.Some (~ g!temp))))))))) (syntax: #export (!!! expr) {#.doc (doc "Takes a (Maybe ObjectType) and returns a ObjectType." @@ -1333,12 +1333,12 @@ (= "foo" (!!! (??? "foo"))))} (with_gensyms [g!value] - (wrap (list (` ({(#.Some (~ g!value)) - (~ g!value) + (in (list (` ({(#.Some (~ g!value)) + (~ g!value) - #.None - ("jvm object null")} - (~ expr))))))) + #.None + ("jvm object null")} + (~ expr))))))) (syntax: #export (check {class (..type^ (list))} {unchecked (<>.maybe <code>.any)}) @@ -1357,14 +1357,14 @@ #.None))] (case unchecked (#.Some unchecked) - (wrap (list (` (: (~ check_type) - (let [(~ g!unchecked) (~ unchecked)] - (~ check_code)))))) + (in (list (` (: (~ check_type) + (let [(~ g!unchecked) (~ unchecked)] + (~ check_code)))))) #.None - (wrap (list (` (: (-> (primitive "java.lang.Object") (~ check_type)) - (function ((~ g!_) (~ g!unchecked)) - (~ check_code)))))) + (in (list (` (: (-> (primitive "java.lang.Object") (~ check_type)) + (function ((~ g!_) (~ g!unchecked)) + (~ check_code)))))) )))) (syntax: #export (synchronized lock body) @@ -1373,7 +1373,7 @@ (exec (do_something ___) (do_something_else ___) (finish_the_computation ___))))} - (wrap (list (` ("jvm object synchronized" (~ lock) (~ body)))))) + (in (list (` ("jvm object synchronized" (~ lock) (~ body)))))) (syntax: #export (do_to obj {methods (<>.some partial_call^)}) {#.doc (doc "Call a variety of methods on an object. Then, return the object." @@ -1381,9 +1381,9 @@ (ClassName::method1 arg0 arg1 arg2) (ClassName::method2 arg3 arg4 arg5)))} (with_gensyms [g!obj] - (wrap (list (` (let [(~ g!obj) (~ obj)] - (exec (~+ (list\map (complete_call$ g!obj) methods)) - (~ g!obj)))))))) + (in (list (` (let [(~ g!obj) (~ obj)] + (exec (~+ (list\map (complete_call$ g!obj) methods)) + (~ g!obj)))))))) (def: (class_import$ declaration) (-> (Type Declaration) Code) @@ -1424,7 +1424,7 @@ (: (-> [Bit (Type Value)] (Meta [Bit Code])) (function (_ [maybe? _]) (with_gensyms [arg_name] - (wrap [maybe? arg_name])))) + (in [maybe? arg_name])))) import_member_args) #let [input_jvm_types (list\map product.right import_member_args) arg_types (list\map (: (-> [Bit (Type Value)] Code) @@ -1434,12 +1434,12 @@ (` (Maybe (~ arg_type))) arg_type)))) import_member_args)]] - (wrap [arg_inputs input_jvm_types arg_types]))) + (in [arg_inputs input_jvm_types arg_types]))) _ - (\ meta.monad wrap [(list) (list) (list)]))) + (\ meta.monad in [(list) (list) (list)]))) -(def: (decorate_return_maybe member never_null? unboxed return_term) +(def: (with_return_maybe member never_null? unboxed return_term) (-> Import_Member_Declaration Bit (Type Value) Code Code) (case member (^or (#ConstructorDecl [commons _]) (#MethodDecl [commons _])) @@ -1473,8 +1473,8 @@ _ return_term))] - [decorate_return_try #import_member_try? (` (.try (~ return_term)))] - [decorate_return_io #import_member_io? (` ((~! io.io) (~ return_term)))] + [with_return_try #import_member_try? (` (.try (~ return_term)))] + [with_return_io #import_member_io? (` ((~! io.io) (~ return_term)))] ) (def: $String @@ -1518,7 +1518,7 @@ _ (` (.|> (~ unboxed/boxed) (~+ post))))))] - [#1 auto_convert_input ..unbox + [#1 with_automatic_input_conversion ..unbox [[type.boolean type.boolean (list (` (.: .Bit)) (` (.:as (.primitive (~ (code.text box.boolean)))))) []] [type.byte type.byte (list (` (.: .Int)) (` (.:as (.primitive (~ (code.text box.long))))) (` ..long_to_byte)) []] [type.short type.short (list (` (.: .Int)) (` (.:as (.primitive (~ (code.text box.long))))) (` ..long_to_short)) []] @@ -1530,7 +1530,7 @@ [(type.class box.boolean (list)) (type.class box.boolean (list)) (list (` (.: .Bit)) (` (.:as (.primitive (~ (code.text box.boolean)))))) []] [(type.class box.long (list)) (type.class box.long (list)) (list (` (.: .Int)) (` (.:as (.primitive (~ (code.text box.long)))))) []] [(type.class box.double (list)) (type.class box.double (list)) (list (` (.: .Frac)) (` (.:as (.primitive (~ (code.text box.double)))))) []]]] - [#0 auto_convert_output ..box + [#0 with_automatic_output_conversion ..box [[type.boolean type.boolean (list) [(` (.: (.primitive (~ (code.text box.boolean))))) (` (.:as .Bit))]] [type.byte type.long (list (` "jvm conversion byte-to-long")) [(` (.: (.primitive (~ (code.text box.long))))) (` (.:as .Int))]] [type.short type.long (list (` "jvm conversion short-to-long")) [(` (.: (.primitive (~ (code.text box.long))))) (` (.:as .Int))]] @@ -1558,7 +1558,7 @@ ((~! !!!) (~ (un_quote input))))) (un_quote input)) [class] - (auto_convert_input mode)))))) + (with_automatic_input_conversion mode)))))) (def: (import_name format class member) (-> Text Text Text Text) @@ -1586,7 +1586,7 @@ (` (def: (~ getter_name) (~ enum_type) (~ (get_static_field full_name name)))))))]] - (wrap (list\map getter_interop enum_members))) + (in (list\map getter_interop enum_members))) (#ConstructorDecl [commons _]) (do meta.monad @@ -1600,12 +1600,12 @@ (~+ (|> (jvm_invoke_inputs (get@ #import_member_mode commons) input_jvm_types arg_function_inputs) (list.zipped/2 input_jvm_types) (list\map ..decorate_input)))))] - (auto_convert_output (get@ #import_member_mode commons)) - (decorate_return_maybe member true classT) - (decorate_return_try member) - (decorate_return_io member))]] - (wrap (list (` ((~! syntax:) ((~ def_name) (~+ (list\map product.right arg_function_inputs))) - ((~' wrap) (.list (.` (~ jvm_interop))))))))) + (with_automatic_output_conversion (get@ #import_member_mode commons)) + (with_return_maybe member true classT) + (with_return_try member) + (with_return_io member))]] + (in (list (` ((~! syntax:) ((~ def_name) (~+ (list\map product.right arg_function_inputs))) + ((~' in) (.list (.` (~ jvm_interop))))))))) (#MethodDecl [commons method]) (with_gensyms [g!obj] @@ -1639,7 +1639,7 @@ (~+ (|> object_ast (list\map ..un_quote) (list.zipped/2 (list (type.class full_name (list)))) - (list\map (auto_convert_input (get@ #import_member_mode commons))))) + (list\map (with_automatic_input_conversion (get@ #import_member_mode commons))))) (~+ (|> (jvm_invoke_inputs (get@ #import_member_mode commons) input_jvm_types arg_function_inputs) (list.zipped/2 input_jvm_types) (list\map ..decorate_input)))))) @@ -1648,18 +1648,18 @@ (#.Left method_return) (|> [method_return callC] - (auto_convert_output (get@ #import_member_mode commons)) - (decorate_return_maybe member false method_return) - (decorate_return_try member) - (decorate_return_io member)) + (with_automatic_output_conversion (get@ #import_member_mode commons)) + (with_return_maybe member false method_return) + (with_return_try member) + (with_return_io member)) (#.Right method_return) (|> callC - (decorate_return_try member) - (decorate_return_io member))))]] - (wrap (list (` ((~! syntax:) ((~ def_name) (~+ (list\map product.right arg_function_inputs)) (~+ object_ast)) - ((~' wrap) (.list (.` (~ jvm_interop)))))))))) + (with_return_try member) + (with_return_io member))))]] + (in (list (` ((~! syntax:) ((~ def_name) (~+ (list\map product.right arg_function_inputs)) (~+ object_ast)) + ((~' in) (.list (.` (~ jvm_interop)))))))))) (#FieldAccessDecl fad) (do meta.monad @@ -1670,7 +1670,7 @@ (let [getter_call (if import_field_static? (` ((~ getter_name))) (` ((~ getter_name) (~ g!obj)))) - getter_body (<| (auto_convert_output import_field_mode) + getter_body (<| (with_automatic_output_conversion import_field_mode) [import_field_type (if import_field_static? (get_static_field full_name import_field_name) @@ -1681,8 +1681,8 @@ getter_body (if import_field_setter? (` ((~! io.io) (~ getter_body))) getter_body)] - (wrap (` ((~! syntax:) (~ getter_call) - ((~' wrap) (.list (.` (~ getter_body))))))))) + (in (` ((~! syntax:) (~ getter_call) + ((~' in) (.list (.` (~ getter_body))))))))) setter_interop (: (Meta (List Code)) (if import_field_setter? (with_gensyms [g!obj g!value] @@ -1690,7 +1690,7 @@ (` ((~ setter_name) (~ g!value))) (` ((~ setter_name) (~ g!value) (~ g!obj)))) setter_value (|> [import_field_type (un_quote g!value)] - (auto_convert_input import_field_mode)) + (with_automatic_input_conversion import_field_mode)) setter_value (if import_field_maybe? (` ((~! !!!) (~ setter_value))) setter_value) @@ -1700,10 +1700,10 @@ (if import_field_static? (list) (list (un_quote g!obj))))] - (wrap (list (` ((~! syntax:) (~ setter_call) - ((~' wrap) (.list (.` ((~! io.io) ((~ (code.text setter_command)) (~+ g!obj+) (~ setter_value)))))))))))) - (wrap (list))))] - (wrap (list& getter_interop setter_interop))) + (in (list (` ((~! syntax:) (~ setter_call) + ((~' in) (.list (.` ((~! io.io) ((~ (code.text setter_command)) (~+ g!obj+) (~ setter_value)))))))))))) + (in (list))))] + (in (list& getter_interop setter_interop))) ))) (def: (member_import$ vars kind class [import_format member]) @@ -1733,9 +1733,9 @@ (let [[class_name _] (parser.declaration declaration)] (case (load_class class_name) (#.Right class) - (\ meta.monad wrap (if (interface? class) - #Interface - #Class)) + (\ meta.monad in (if (interface? class) + #Interface + #Class)) (#.Left _) (meta.failure (format "Unknown class: " class_name))))) @@ -1802,7 +1802,7 @@ (list\map (|>> [import_format]) members))) list.concat (monad.map ! (member_import$ class_type_vars kind declaration)))] - (wrap (list& (class_import$ declaration) (list\join =members))))) + (in (list& (class_import$ declaration) (list\join =members))))) (syntax: #export (array {type (..type^ (list))} size) @@ -1815,7 +1815,7 @@ "jvm conversion long-to-int"))] (`` (cond (~~ (template [<primitive> <array_op>] [(\ type.equivalence = <primitive> type) - (wrap (list (` (<array_op> (~ g!size)))))] + (in (list (` (<array_op> (~ g!size)))))] [type.boolean "jvm array new boolean"] [type.byte "jvm array new byte"] @@ -1826,8 +1826,8 @@ [type.double "jvm array new double"] [type.char "jvm array new char"])) ## else - (wrap (list (` (: (~ (value_type #ManualPrM (type.array type))) - ("jvm array new object" (~ g!size)))))))))) + (in (list (` (: (~ (value_type #ManualPrM (type.array type))) + ("jvm array new object" (~ g!size)))))))))) (exception: #export (cannot_convert_to_jvm_type {type .Type}) (exception.report @@ -1837,14 +1837,14 @@ (def: (lux_type->jvm_type type) (-> .Type (Meta (Type Value))) (if (lux_type\= .Any type) - (\ meta.monad wrap $Object) + (\ meta.monad in $Object) (case type (#.Primitive name params) (`` (cond (~~ (template [<type>] [(text\= (..reflection <type>) name) (case params #.Nil - (\ meta.monad wrap <type>) + (\ meta.monad in <type>) _ <failure>)] @@ -1862,7 +1862,7 @@ [(text\= (..reflection (type.array <type>)) name) (case params #.Nil - (\ meta.monad wrap (type.array <type>)) + (\ meta.monad in (type.array <type>)) _ <failure>)] @@ -1904,7 +1904,7 @@ [paramJT (lux_type->jvm_type paramLT)] (case (parser.parameter? paramJT) (#.Some paramJT) - (wrap paramJT) + (in paramJT) #.None <failure>))) @@ -1930,7 +1930,7 @@ (case array [_ (#.Identifier array_name)] (do meta.monad - [array_type (meta.find_type array_name) + [array_type (meta.type array_name) array_jvm_type (lux_type->jvm_type array_type) #let [g!extension (code.text (`` (cond (~~ (template [<primitive> <extension>] [(\ type.equivalence = @@ -1949,16 +1949,16 @@ ## else "jvm array length object")))]] - (wrap (list (` (.|> ((~ g!extension) (~ array)) - "jvm conversion int-to-long" - "jvm object cast" - (.: (.primitive (~ (code.text box.long)))) - (.:as .Nat)))))) + (in (list (` (.|> ((~ g!extension) (~ array)) + "jvm conversion int-to-long" + "jvm object cast" + (.: (.primitive (~ (code.text box.long)))) + (.:as .Nat)))))) _ (with_gensyms [g!array] - (wrap (list (` (let [(~ g!array) (~ array)] - (..array_length (~ g!array))))))))) + (in (list (` (let [(~ g!array) (~ array)] + (..array_length (~ g!array))))))))) (syntax: #export (array_read idx array) {#.doc (doc "Loads an element from an array." @@ -1966,7 +1966,7 @@ (case array [_ (#.Identifier array_name)] (do meta.monad - [array_type (meta.find_type array_name) + [array_type (meta.type array_name) array_jvm_type (lux_type->jvm_type array_type) #let [g!idx (` (.|> (~ idx) (.: .Nat) @@ -1977,9 +1977,9 @@ [(\ type.equivalence = (type.array <primitive>) array_jvm_type) - (wrap (list (` (.|> (<extension> (~ g!idx) (~ array)) - "jvm object cast" - (.: (.primitive (~ (code.text <box>))))))))] + (in (list (` (.|> (<extension> (~ g!idx) (~ array)) + "jvm object cast" + (.: (.primitive (~ (code.text <box>))))))))] [type.boolean "jvm array read boolean" box.boolean] [type.byte "jvm array read byte" box.byte] @@ -1991,12 +1991,12 @@ [type.char "jvm array read char" box.char])) ## else - (wrap (list (` ("jvm array read object" (~ g!idx) (~ array)))))))) + (in (list (` ("jvm array read object" (~ g!idx) (~ array)))))))) _ (with_gensyms [g!array] - (wrap (list (` (let [(~ g!array) (~ array)] - (..array_read (~ idx) (~ g!array))))))))) + (in (list (` (let [(~ g!array) (~ array)] + (..array_read (~ idx) (~ g!array))))))))) (syntax: #export (array_write idx value array) {#.doc (doc "Stores an element into an array." @@ -2004,7 +2004,7 @@ (case array [_ (#.Identifier array_name)] (do meta.monad - [array_type (meta.find_type array_name) + [array_type (meta.type array_name) array_jvm_type (lux_type->jvm_type array_type) #let [g!idx (` (.|> (~ idx) (.: .Nat) @@ -2018,7 +2018,7 @@ (let [g!value (` (.|> (~ value) (.:as (.primitive (~ (code.text <box>)))) "jvm object cast"))] - (wrap (list (` (<extension> (~ g!idx) (~ g!value) (~ array))))))] + (in (list (` (<extension> (~ g!idx) (~ g!value) (~ array))))))] [type.boolean "jvm array write boolean" box.boolean] [type.byte "jvm array write byte" box.byte] @@ -2030,20 +2030,20 @@ [type.char "jvm array write char" box.char])) ## else - (wrap (list (` ("jvm array write object" (~ g!idx) (~ value) (~ array)))))))) + (in (list (` ("jvm array write object" (~ g!idx) (~ value) (~ array)))))))) _ (with_gensyms [g!array] - (wrap (list (` (let [(~ g!array) (~ array)] - (..array_write (~ idx) (~ value) (~ g!array))))))))) + (in (list (` (let [(~ g!array) (~ array)] + (..array_write (~ idx) (~ value) (~ g!array))))))))) (syntax: #export (class_for {type (..type^ (list))}) {#.doc (doc "Loads the class as a java.lang.Class object." (class_for java/lang/String))} - (wrap (list (` ("jvm object class" (~ (code.text (..reflection type)))))))) + (in (list (` ("jvm object class" (~ (code.text (..reflection type)))))))) (syntax: #export (type {type (..type^ (list))}) - (wrap (list (..value_type #ManualPrM type)))) + (in (list (..value_type #ManualPrM type)))) (exception: #export (cannot_cast_to_non_object {type (Type Value)}) (exception.report @@ -2055,8 +2055,8 @@ (case [(parser.array? type) (parser.class? type)] (^or [(#.Some _) _] [_ (#.Some _)]) - (wrap (list (` (.: (~ (..value_type #ManualPrM type)) - ("jvm object cast" (~ object)))))) + (in (list (` (.: (~ (..value_type #ManualPrM type)) + ("jvm object cast" (~ object)))))) _ (meta.failure (exception.construct ..cannot_cast_to_non_object [type])))) diff --git a/stdlib/source/library/lux/ffi.lua.lux b/stdlib/source/library/lux/ffi.lua.lux index 1eb32b3bf..a1481fa45 100644 --- a/stdlib/source/library/lux/ffi.lua.lux +++ b/stdlib/source/library/lux/ffi.lua.lux @@ -73,7 +73,7 @@ (def: constant (Parser Field) (<code>.form ($_ <>.and - (<>\wrap true) + (<>\in true) <code>.local_identifier ..nilable))) @@ -235,71 +235,71 @@ #.Nil (` ("lua import" (~ (code.text class)))))] - (wrap (list& (` (type: (~ g!type) - (..Object (primitive (~ (code.text real_class)))))) - (list\map (function (_ member) - (case member - (#Field [static? field fieldT]) - (if static? - (` ((~! syntax:) ((~ (qualify field))) - (\ (~! meta.monad) (~' wrap) - (list (` (.:as (~ (nilable_type fieldT)) - ("lua object get" (~ (code.text field)) - (:as (..Object .Any) (~ imported))))))))) - (` (def: ((~ (qualify field)) + (in (list& (` (type: (~ g!type) + (..Object (primitive (~ (code.text real_class)))))) + (list\map (function (_ member) + (case member + (#Field [static? field fieldT]) + (if static? + (` ((~! syntax:) ((~ (qualify field))) + (\ (~! meta.monad) (~' in) + (list (` (.:as (~ (nilable_type fieldT)) + ("lua object get" (~ (code.text field)) + (:as (..Object .Any) (~ imported))))))))) + (` (def: ((~ (qualify field)) + (~ g!object)) + (-> (~ g!type) + (~ (nilable_type fieldT))) + (:assume + (~ (without_nil g!temp fieldT (` ("lua object get" (~ (code.text field)) + (:as (..Object .Any) (~ g!object)))))))))) + + (#Method method) + (case method + (#Static [method alias inputsT io? try? outputT]) + (..make_function (qualify (maybe.default method alias)) + g!temp + (` ("lua object get" (~ (code.text method)) + (:as (..Object .Any) (~ imported)))) + inputsT + io? + try? + outputT) + + (#Virtual [method alias inputsT io? try? outputT]) + (let [g!inputs (input_variables inputsT)] + (` (def: ((~ (qualify (maybe.default method alias))) + [(~+ (list\map product.right g!inputs))] (~ g!object)) - (-> (~ g!type) - (~ (nilable_type fieldT))) + (-> [(~+ (list\map nilable_type inputsT))] + (~ g!type) + (~ (|> (nilable_type outputT) + (try_type try?) + (io_type io?)))) (:assume - (~ (without_nil g!temp fieldT (` ("lua object get" (~ (code.text field)) - (:as (..Object .Any) (~ g!object)))))))))) - - (#Method method) - (case method - (#Static [method alias inputsT io? try? outputT]) - (..make_function (qualify (maybe.default method alias)) - g!temp - (` ("lua object get" (~ (code.text method)) - (:as (..Object .Any) (~ imported)))) - inputsT - io? - try? - outputT) - - (#Virtual [method alias inputsT io? try? outputT]) - (let [g!inputs (input_variables inputsT)] - (` (def: ((~ (qualify (maybe.default method alias))) - [(~+ (list\map product.right g!inputs))] - (~ g!object)) - (-> [(~+ (list\map nilable_type inputsT))] - (~ g!type) - (~ (|> (nilable_type outputT) - (try_type try?) - (io_type io?)))) - (:assume - (~ (<| (with_io io?) - (with_try try?) - (without_nil g!temp outputT) - (` ("lua object do" - (~ (code.text method)) - (~ g!object) - (~+ (list\map (with_nil g!temp) g!inputs))))))))))))) - members))))) + (~ (<| (with_io io?) + (with_try try?) + (without_nil g!temp outputT) + (` ("lua object do" + (~ (code.text method)) + (~ g!object) + (~+ (list\map (with_nil g!temp) g!inputs))))))))))))) + members))))) (#Function [name alias inputsT io? try? outputT]) - (wrap (list (..make_function (code.local_identifier (maybe.default name alias)) - g!temp - (` ("lua constant" (~ (code.text (text.replace_all "/" "." name))))) - inputsT - io? - try? - outputT))) + (in (list (..make_function (code.local_identifier (maybe.default name alias)) + g!temp + (` ("lua constant" (~ (code.text (text.replace_all "/" "." name))))) + inputsT + io? + try? + outputT))) (#Constant [_ name fieldT]) - (wrap (list (` ((~! syntax:) ((~ (code.local_identifier name))) - (\ (~! meta.monad) (~' wrap) - (list (` (.:as (~ (nilable_type fieldT)) - ("lua constant" (~ (code.text (text.replace_all "/" "." name)))))))))))) + (in (list (` ((~! syntax:) ((~ (code.local_identifier name))) + (\ (~! meta.monad) (~' in) + (list (` (.:as (~ (nilable_type fieldT)) + ("lua constant" (~ (code.text (text.replace_all "/" "." name)))))))))))) ))) (template: #export (closure <inputs> <output>) diff --git a/stdlib/source/library/lux/ffi.old.lux b/stdlib/source/library/lux/ffi.old.lux index a023d3afe..ff9ef9f31 100644 --- a/stdlib/source/library/lux/ffi.old.lux +++ b/stdlib/source/library/lux/ffi.old.lux @@ -389,14 +389,14 @@ (do <>.monad [#let [dotted_name (format "::" field_name)] _ (<code>.this! (code.identifier ["" dotted_name]))] - (wrap (`' ((~ (code.text (format "jvm getstatic" ":" class_name ":" field_name)))))))) + (in (`' ((~ (code.text (format "jvm getstatic" ":" class_name ":" field_name)))))))) (def: (make_get_var_parser class_name field_name) (-> Text Text (Parser Code)) (do <>.monad [#let [dotted_name (format "::" field_name)] _ (<code>.this! (code.identifier ["" dotted_name]))] - (wrap (`' ((~ (code.text (format "jvm getfield" ":" class_name ":" field_name))) _jvm_this))))) + (in (`' ((~ (code.text (format "jvm getfield" ":" class_name ":" field_name))) _jvm_this))))) (def: (make_put_var_parser class_name field_name) (-> Text Text (Parser Code)) @@ -404,7 +404,7 @@ [#let [dotted_name (format "::" field_name)] [_ _ value] (: (Parser [Any Any Code]) (<code>.form ($_ <>.and (<code>.this! (' :=)) (<code>.this! (code.identifier ["" dotted_name])) <code>.any)))] - (wrap (`' ((~ (code.text (format "jvm putfield" ":" class_name ":" field_name))) _jvm_this (~ value)))))) + (in (`' ((~ (code.text (format "jvm putfield" ":" class_name ":" field_name))) _jvm_this (~ value)))))) (def: (pre_walk_replace f input) (-> (-> Code Code) Code Code) @@ -451,8 +451,8 @@ (<code>.form (<>.after (<code>.this! (' ::new!)) (<code>.tuple (<>.exactly (list.size arg_decls) <code>.any))))) #let [arg_decls' (: (List Text) (list\map (|>> product.right (simple_class$ params)) arg_decls))]] - (wrap (` ((~ (code.text (format "jvm new" ":" class_name ":" (text.join_with "," arg_decls')))) - (~+ args)))))) + (in (` ((~ (code.text (format "jvm new" ":" class_name ":" (text.join_with "," arg_decls')))) + (~+ args)))))) (def: (make_static_method_parser params class_name method_name arg_decls) (-> (List Type_Parameter) Text Text (List ArgDecl) (Parser Code)) @@ -462,8 +462,8 @@ (<code>.form (<>.after (<code>.this! (code.identifier ["" dotted_name])) (<code>.tuple (<>.exactly (list.size arg_decls) <code>.any))))) #let [arg_decls' (: (List Text) (list\map (|>> product.right (simple_class$ params)) arg_decls))]] - (wrap (`' ((~ (code.text (format "jvm invokestatic" ":" class_name ":" method_name ":" (text.join_with "," arg_decls')))) - (~+ args)))))) + (in (`' ((~ (code.text (format "jvm invokestatic" ":" class_name ":" method_name ":" (text.join_with "," arg_decls')))) + (~+ args)))))) (template [<name> <jvm_op>] [(def: (<name> params class_name method_name arg_decls) @@ -474,8 +474,8 @@ (<code>.form (<>.after (<code>.this! (code.identifier ["" dotted_name])) (<code>.tuple (<>.exactly (list.size arg_decls) <code>.any))))) #let [arg_decls' (: (List Text) (list\map (|>> product.right (simple_class$ params)) arg_decls))]] - (wrap (`' ((~ (code.text (format <jvm_op> ":" class_name ":" method_name ":" (text.join_with "," arg_decls')))) - (~' _jvm_this) (~+ args))))))] + (in (`' ((~ (code.text (format <jvm_op> ":" class_name ":" method_name ":" (text.join_with "," arg_decls')))) + (~' _jvm_this) (~+ args))))))] [make_special_method_parser "jvm invokespecial"] [make_virtual_method_parser "jvm invokevirtual"] @@ -508,7 +508,7 @@ (<code>.this! (' #public)) (<code>.this! (' #private)) (<code>.this! (' #protected)) - (wrap [])))) + (in [])))) (def: inheritance_modifier^ (Parser Inheritance) @@ -516,7 +516,7 @@ ($_ <>.or (<code>.this! (' #final)) (<code>.this! (' #abstract)) - (wrap [])))) + (in [])))) (def: bound_kind^ (Parser BoundKind) @@ -535,24 +535,24 @@ ($_ <>.either (do <>.monad [_ (<code>.this! (' ?))] - (wrap (#GenericWildcard #.None))) + (in (#GenericWildcard #.None))) (<code>.tuple (do <>.monad [_ (<code>.this! (' ?)) bound_kind bound_kind^ bound recur^] - (wrap (#GenericWildcard (#.Some [bound_kind bound]))))) + (in (#GenericWildcard (#.Some [bound_kind bound]))))) (do <>.monad [name <code>.local_identifier _ (assert_no_periods name)] (if (list.member? text.equivalence (list\map product.left type_vars) name) - (wrap (#GenericTypeVar name)) - (wrap (#GenericClass name (list))))) + (in (#GenericTypeVar name)) + (in (#GenericClass name (list))))) (<code>.tuple (do <>.monad [component recur^] (case component (^template [<class> <name>] [(#GenericClass <name> #.Nil) - (wrap (#GenericClass <class> (list)))]) + (in (#GenericClass <class> (list)))]) (["[Z" "boolean"] ["[B" "byte"] ["[S" "short"] @@ -563,26 +563,26 @@ ["[C" "char"]) _ - (wrap (#GenericArray component))))) + (in (#GenericArray component))))) (<code>.form (do <>.monad [name <code>.local_identifier _ (assert_no_periods name) params (<>.some recur^) _ (<>.assert (format name " cannot be a type-parameter!") (not (list.member? text.equivalence (list\map product.left type_vars) name)))] - (wrap (#GenericClass name params)))) + (in (#GenericClass name params)))) )))) (def: type_param^ (Parser Type_Parameter) (<>.either (do <>.monad [param_name <code>.local_identifier] - (wrap [param_name (list)])) + (in [param_name (list)])) (<code>.tuple (do <>.monad [param_name <code>.local_identifier _ (<code>.this! (' <)) bounds (<>.many (..generic_type^ (list)))] - (wrap [param_name bounds]))))) + (in [param_name bounds]))))) (def: type_params^ (Parser (List Type_Parameter)) @@ -596,12 +596,12 @@ (<>.either (do <>.monad [name <code>.local_identifier _ (assert_no_periods name)] - (wrap [name (list)])) + (in [name (list)])) (<code>.form (do <>.monad [name <code>.local_identifier _ (assert_no_periods name) params (<>.some ..type_param^)] - (wrap [name params]))) + (in [name params]))) )) (def: (super_class_decl^ type_vars) @@ -609,12 +609,12 @@ (<>.either (do <>.monad [name <code>.local_identifier _ (assert_no_periods name)] - (wrap [name (list)])) + (in [name (list)])) (<code>.form (do <>.monad [name <code>.local_identifier _ (assert_no_periods name) params (<>.some (..generic_type^ type_vars))] - (wrap [name params]))))) + (in [name params]))))) (def: annotation_params^ (Parser (List AnnotationParam)) @@ -624,7 +624,7 @@ (Parser Annotation) (<>.either (do <>.monad [ann_name <code>.local_identifier] - (wrap [ann_name (list)])) + (in [ann_name (list)])) (<code>.form (<>.and <code>.local_identifier annotation_params^)))) @@ -638,7 +638,7 @@ (Parser (List Annotation)) (do <>.monad [anns?? (<>.maybe ..annotations^')] - (wrap (maybe.default (list) anns??)))) + (in (maybe.default (list) anns??)))) (def: (throws_decl'^ type_vars) (-> (List Type_Parameter) (Parser (List GenericType))) @@ -650,7 +650,7 @@ (-> (List Type_Parameter) (Parser (List GenericType))) (do <>.monad [exs? (<>.maybe (throws_decl'^ type_vars))] - (wrap (maybe.default (list) exs?)))) + (in (maybe.default (list) exs?)))) (def: (method_decl^ type_vars) (-> (List Type_Parameter) (Parser [Member_Declaration MethodDecl])) @@ -661,17 +661,17 @@ inputs (<code>.tuple (<>.some (..generic_type^ type_vars))) output (..generic_type^ type_vars) exs (..throws_decl^ type_vars)] - (wrap [[name #PublicP anns] {#method_tvars tvars - #method_inputs inputs - #method_output output - #method_exs exs}])))) + (in [[name #PublicP anns] {#method_tvars tvars + #method_inputs inputs + #method_output output + #method_exs exs}])))) (def: state_modifier^ (Parser State) ($_ <>.or (<code>.this! (' #volatile)) (<code>.this! (' #final)) - (\ <>.monad wrap []))) + (\ <>.monad in []))) (def: (field_decl^ type_vars) (-> (List Type_Parameter) (Parser [Member_Declaration FieldDecl])) @@ -681,14 +681,14 @@ anns ..annotations^ type (..generic_type^ type_vars) body <code>.any] - (wrap [[name #PublicP anns] (#ConstantField [type body])]))) + (in [[name #PublicP anns] (#ConstantField [type body])]))) (<code>.form (do <>.monad [pm privacy_modifier^ sm state_modifier^ name <code>.local_identifier anns ..annotations^ type (..generic_type^ type_vars)] - (wrap [[name pm anns] (#VariableField [sm type])]))))) + (in [[name pm anns] (#VariableField [sm type])]))))) (def: (arg_decl^ type_vars) (-> (List Type_Parameter) (Parser ArgDecl)) @@ -720,10 +720,10 @@ exs (..throws_decl^ total_vars) annotations ..annotations^ body <code>.any] - (wrap [{#member_name constructor_method_name - #member_privacy pm - #member_anns annotations} - (#ConstructorMethod strict_fp? method_vars arg_decls constructor_args body exs)])))) + (in [{#member_name constructor_method_name + #member_privacy pm + #member_anns annotations} + (#ConstructorMethod strict_fp? method_vars arg_decls constructor_args body exs)])))) (def: (virtual_method_def^ class_vars) (-> (List Type_Parameter) (Parser [Member_Declaration Method_Definition])) @@ -741,13 +741,13 @@ exs (..throws_decl^ total_vars) annotations ..annotations^ body <code>.any] - (wrap [{#member_name name - #member_privacy pm - #member_anns annotations} - (#VirtualMethod final? strict_fp? - method_vars - this_name arg_decls return_type - body exs)])))) + (in [{#member_name name + #member_privacy pm + #member_anns annotations} + (#VirtualMethod final? strict_fp? + method_vars + this_name arg_decls return_type + body exs)])))) (def: overriden_method_def^ (Parser [Member_Declaration Method_Definition]) @@ -764,13 +764,13 @@ exs (..throws_decl^ total_vars) annotations ..annotations^ body <code>.any] - (wrap [{#member_name name - #member_privacy #PublicP - #member_anns annotations} - (#OverridenMethod strict_fp? - owner_class method_vars - this_name arg_decls return_type - body exs)])))) + (in [{#member_name name + #member_privacy #PublicP + #member_anns annotations} + (#OverridenMethod strict_fp? + owner_class method_vars + this_name arg_decls return_type + body exs)])))) (def: static_method_def^ (Parser [Member_Declaration Method_Definition]) @@ -786,10 +786,10 @@ exs (..throws_decl^ total_vars) annotations ..annotations^ body <code>.any] - (wrap [{#member_name name - #member_privacy pm - #member_anns annotations} - (#StaticMethod strict_fp? method_vars arg_decls return_type body exs)])))) + (in [{#member_name name + #member_privacy pm + #member_anns annotations} + (#StaticMethod strict_fp? method_vars arg_decls return_type body exs)])))) (def: abstract_method_def^ (Parser [Member_Declaration Method_Definition]) @@ -803,10 +803,10 @@ return_type (..generic_type^ total_vars) exs (..throws_decl^ total_vars) annotations ..annotations^] - (wrap [{#member_name name - #member_privacy pm - #member_anns annotations} - (#AbstractMethod method_vars arg_decls return_type exs)])))) + (in [{#member_name name + #member_privacy pm + #member_anns annotations} + (#AbstractMethod method_vars arg_decls return_type exs)])))) (def: native_method_def^ (Parser [Member_Declaration Method_Definition]) @@ -820,10 +820,10 @@ return_type (..generic_type^ total_vars) exs (..throws_decl^ total_vars) annotations ..annotations^] - (wrap [{#member_name name - #member_privacy pm - #member_anns annotations} - (#NativeMethod method_vars arg_decls return_type exs)])))) + (in [{#member_name name + #member_privacy pm + #member_anns annotations} + (#NativeMethod method_vars arg_decls return_type exs)])))) (def: (method_def^ class_vars) (-> (List Type_Parameter) (Parser [Member_Declaration Method_Definition])) @@ -843,10 +843,10 @@ (Parser Class_Kind) (<>.either (do <>.monad [_ (<code>.this! (' #class))] - (wrap #Class)) + (in #Class)) (do <>.monad [_ (<code>.this! (' #interface))] - (wrap #Interface)) + (in #Interface)) )) (def: import_member_alias^ @@ -874,7 +874,7 @@ (<code>.form (do <>.monad [_ (<code>.this! (' #enum)) enum_members (<>.some <code>.local_identifier)] - (wrap (#EnumDecl enum_members)))) + (in (#EnumDecl enum_members)))) (<code>.form (do <>.monad [tvars ..type_params^ _ (<code>.this! (' new)) @@ -883,20 +883,20 @@ ?prim_mode (<>.maybe primitive_mode^) args (..import_member_args^ total_vars) [io? try? maybe?] import_member_return_flags^] - (wrap (#ConstructorDecl [{#import_member_mode (maybe.default #AutoPrM ?prim_mode) - #import_member_alias (maybe.default "new" ?alias) - #import_member_kind #VirtualIMK - #import_member_tvars tvars - #import_member_args args - #import_member_maybe? maybe? - #import_member_try? try? - #import_member_io? io?} - {}])) + (in (#ConstructorDecl [{#import_member_mode (maybe.default #AutoPrM ?prim_mode) + #import_member_alias (maybe.default "new" ?alias) + #import_member_kind #VirtualIMK + #import_member_tvars tvars + #import_member_args args + #import_member_maybe? maybe? + #import_member_try? try? + #import_member_io? io?} + {}])) )) (<code>.form (do <>.monad [kind (: (Parser ImportMethodKind) (<>.or (<code>.this! (' #static)) - (wrap []))) + (in []))) tvars ..type_params^ name <code>.local_identifier ?alias import_member_alias^ @@ -905,17 +905,17 @@ args (..import_member_args^ total_vars) [io? try? maybe?] import_member_return_flags^ return (..generic_type^ total_vars)] - (wrap (#MethodDecl [{#import_member_mode (maybe.default #AutoPrM ?prim_mode) - #import_member_alias (maybe.default name ?alias) - #import_member_kind kind - #import_member_tvars tvars - #import_member_args args - #import_member_maybe? maybe? - #import_member_try? try? - #import_member_io? io?} - {#import_method_name name - #import_method_return return - }])))) + (in (#MethodDecl [{#import_member_mode (maybe.default #AutoPrM ?prim_mode) + #import_member_alias (maybe.default name ?alias) + #import_member_kind kind + #import_member_tvars tvars + #import_member_args args + #import_member_maybe? maybe? + #import_member_try? try? + #import_member_io? io?} + {#import_method_name name + #import_method_return return + }])))) (<code>.form (do <>.monad [static? (<>.parses? (<code>.this! (' #static))) name <code>.local_identifier @@ -923,12 +923,12 @@ gtype (..generic_type^ owner_vars) maybe? (<>.parses? (<code>.this! (' #?))) setter? (<>.parses? (<code>.this! (' #!)))] - (wrap (#FieldAccessDecl {#import_field_mode (maybe.default #AutoPrM ?prim_mode) - #import_field_name name - #import_field_static? static? - #import_field_maybe? maybe? - #import_field_setter? setter? - #import_field_type gtype})))) + (in (#FieldAccessDecl {#import_field_mode (maybe.default #AutoPrM ?prim_mode) + #import_field_name name + #import_field_static? static? + #import_field_maybe? maybe? + #import_field_setter? setter? + #import_field_type gtype})))) )) (def: bundle @@ -1097,11 +1097,11 @@ args (<code>.tuple (<>.exactly (list.size arg_decls) <code>.any)) #let [arg_decls' (: (List Text) (list\map (|>> product.right (simple_class$ (list))) arg_decls))]] - (wrap (`' ((~ (code.text (format "jvm invokespecial" - ":" (get@ #super_class_name super_class) - ":" name - ":" (text.join_with "," arg_decls')))) - (~' _jvm_this) (~+ args)))))))] + (in (`' ((~ (code.text (format "jvm invokespecial" + ":" (get@ #super_class_name super_class) + ":" name + ":" (text.join_with "," arg_decls')))) + (~' _jvm_this) (~+ args)))))))] (with_parens (spaced (list "override" (class_decl$ class_decl) @@ -1223,7 +1223,7 @@ (with_brackets (spaced (list\map annotation$ annotations))) (with_brackets (spaced (list\map field_decl$ fields))) (with_brackets (spaced (list\map (method_def$ replacer super) methods))))))]] - (wrap (list (` ((~ (code.text def_code)))))))) + (in (list (` ((~ (code.text def_code)))))))) (syntax: #export (interface: {class_decl ..class_decl^} @@ -1240,7 +1240,7 @@ (with_brackets (spaced (list\map super_class_decl$ supers))) (with_brackets (spaced (list\map annotation$ annotations))) (spaced (list\map method_decl$ members)))))] - (wrap (list (` ((~ (code.text def_code)))))) + (in (list (` ((~ (code.text def_code)))))) )) (syntax: #export (object @@ -1267,12 +1267,12 @@ (with_brackets (spaced (list\map super_class_decl$ interfaces))) (with_brackets (spaced (list\map constructor_arg$ constructor_args))) (with_brackets (spaced (list\map (method_def$ function.identity super) methods))))))] - (wrap (list (` ((~ (code.text def_code)))))))) + (in (list (` ((~ (code.text def_code)))))))) (syntax: #export (null) {#.doc (doc "Null object reference." (null))} - (wrap (list (` ("jvm object null"))))) + (in (list (` ("jvm object null"))))) (def: #export (null? obj) {#.doc (doc "Test for null object reference." @@ -1290,10 +1290,10 @@ (= (??? "YOLO") (#.Some "YOLO")))} (with_gensyms [g!temp] - (wrap (list (` (let [(~ g!temp) (~ expr)] - (if ("jvm object null?" (~ g!temp)) - #.None - (#.Some (~ g!temp))))))))) + (in (list (` (let [(~ g!temp) (~ expr)] + (if ("jvm object null?" (~ g!temp)) + #.None + (#.Some (~ g!temp))))))))) (syntax: #export (!!! expr) {#.doc (doc "Takes a (Maybe ObjectType) and returns a ObjectType." @@ -1303,12 +1303,12 @@ (= "foo" (!!! (??? "foo"))))} (with_gensyms [g!value] - (wrap (list (` ({(#.Some (~ g!value)) - (~ g!value) + (in (list (` ({(#.Some (~ g!value)) + (~ g!value) - #.None - ("jvm object null")} - (~ expr))))))) + #.None + ("jvm object null")} + (~ expr))))))) (syntax: #export (check {class (..generic_type^ (list))} {unchecked (<>.maybe <code>.any)}) @@ -1327,14 +1327,14 @@ #.None))] (case unchecked (#.Some unchecked) - (wrap (list (` (: (~ check_type) - (let [(~ g!unchecked) (~ unchecked)] - (~ check_code)))))) + (in (list (` (: (~ check_type) + (let [(~ g!unchecked) (~ unchecked)] + (~ check_code)))))) #.None - (wrap (list (` (: (-> (primitive "java.lang.Object") (~ check_type)) - (function ((~ g!_) (~ g!unchecked)) - (~ check_code)))))) + (in (list (` (: (-> (primitive "java.lang.Object") (~ check_type)) + (function ((~ g!_) (~ g!unchecked)) + (~ check_code)))))) )))) (syntax: #export (synchronized lock body) @@ -1343,7 +1343,7 @@ (exec (do_something ___) (do_something_else ___) (finish_the_computation ___))))} - (wrap (list (` ("jvm object synchronized" (~ lock) (~ body)))))) + (in (list (` ("jvm object synchronized" (~ lock) (~ body)))))) (syntax: #export (do_to obj {methods (<>.some partial_call^)}) {#.doc (doc "Call a variety of methods on an object. Then, return the object." @@ -1351,9 +1351,9 @@ (ClassName::method1 arg0 arg1 arg2) (ClassName::method2 arg3 arg4 arg5)))} (with_gensyms [g!obj] - (wrap (list (` (let [(~ g!obj) (~ obj)] - (exec (~+ (list\map (complete_call$ g!obj) methods)) - (~ g!obj)))))))) + (in (list (` (let [(~ g!obj) (~ obj)] + (exec (~+ (list\map (complete_call$ g!obj) methods)) + (~ g!obj)))))))) (def: (class_import$ [full_name params]) (-> Class_Declaration Code) @@ -1392,7 +1392,7 @@ (: (-> [Bit GenericType] (Meta [Bit Code])) (function (_ [maybe? _]) (with_gensyms [arg_name] - (wrap [maybe? arg_name])))) + (in [maybe? arg_name])))) import_member_args) #let [arg_classes (: (List Text) (list\map (|>> product.right (simple_class$ (list\compose type_params import_member_tvars))) @@ -1404,10 +1404,10 @@ (` (Maybe (~ arg_type))) arg_type)))) import_member_args)]] - (wrap [arg_inputs arg_classes arg_types]))) + (in [arg_inputs arg_classes arg_types]))) _ - (\ meta.monad wrap [(list) (list) (list)]))) + (\ meta.monad in [(list) (list) (list)]))) (def: (decorate_return_maybe class member return_term) (-> Class_Declaration Import_Member_Declaration Code Code) @@ -1518,7 +1518,7 @@ (` (def: (~ getter_name) (~ enum_type) ((~ (code.text (format "jvm getstatic" ":" full_name ":" name)))))))))]] - (wrap (list\map getter_interop enum_members))) + (in (list\map getter_interop enum_members))) (#ConstructorDecl [commons _]) (do meta.monad @@ -1529,8 +1529,8 @@ (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))) - ((~' wrap) (.list (.` (~ jvm_interop))))))))) + (in (list (` ((~! syntax:) ((~ def_name) (~+ (list\map product.right arg_function_inputs))) + ((~' in) (.list (.` (~ jvm_interop))))))))) (#MethodDecl [commons method]) (with_gensyms [g!obj] @@ -1562,8 +1562,8 @@ (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)) - ((~' wrap) (.list (.` (~ jvm_interop)))))))))) + (in (list (` ((~! syntax:) ((~ def_name) (~+ (list\map product.right arg_function_inputs)) (~+ object_ast)) + ((~' in) (.list (.` (~ jvm_interop)))))))))) (#FieldAccessDecl fad) (do meta.monad @@ -1596,8 +1596,8 @@ getter_body (if import_field_setter? (` ((~! io.io) (~ getter_body))) getter_body)] - (wrap (` ((~! syntax:) (~ getter_call) - ((~' wrap) (.list (.` (~ getter_body))))))))) + (in (` ((~! syntax:) (~ getter_call) + ((~' in) (.list (.` (~ getter_body))))))))) setter_interop (: (Meta (List Code)) (if import_field_setter? (with_gensyms [g!obj g!value] @@ -1615,10 +1615,10 @@ (if import_field_static? (list) (list (un_quote g!obj))))] - (wrap (list (` ((~! syntax:) (~ setter_call) - ((~' wrap) (.list (.` ((~! io.io) ((~ (code.text setter_command)) (~+ g!obj+) (~ setter_value)))))))))))) - (wrap (list))))] - (wrap (list& getter_interop setter_interop))) + (in (list (` ((~! syntax:) (~ setter_call) + ((~' in) (.list (.` ((~! io.io) ((~ (code.text setter_command)) (~+ g!obj+) (~ setter_value)))))))))))) + (in (list))))] + (in (list& getter_interop setter_interop))) ))) (def: (member_import$ type_params kind class [import_format member]) @@ -1644,9 +1644,9 @@ (let [class_name (..safe class_name)] (case (..load_class class_name) (#try.Success class) - (\ meta.monad wrap (if (interface? class) - #Interface - #Class)) + (\ meta.monad in (if (interface? class) + #Interface + #Class)) (#try.Failure error) (meta.failure (format "Cannot load class: " class_name text.new_line @@ -1713,7 +1713,7 @@ (list\map (|>> [import_format]) members))) list.concat (monad.map ! (member_import$ (product.right class_decl) kind class_decl)))] - (wrap (list& (class_import$ class_decl) (list\join =members))))) + (in (list& (class_import$ class_decl) (list\join =members))))) (syntax: #export (array {type (..generic_type^ (list))} size) @@ -1722,7 +1722,7 @@ (case type (^template [<type> <array_op>] [(^ (#GenericClass <type> (list))) - (wrap (list (` (<array_op> (~ size)))))]) + (in (list (` (<array_op> (~ size)))))]) (["boolean" "jvm znewarray"] ["byte" "jvm bnewarray"] ["short" "jvm snewarray"] @@ -1733,20 +1733,20 @@ ["char" "jvm cnewarray"]) _ - (wrap (list (` ("jvm anewarray" (~ (code.text (generic_type$ type))) (~ size))))))) + (in (list (` ("jvm anewarray" (~ (code.text (generic_type$ type))) (~ size))))))) (syntax: #export (array_length array) {#.doc (doc "Gives the length of an array." (array_length my_array))} - (wrap (list (` ("jvm arraylength" (~ array)))))) + (in (list (` ("jvm arraylength" (~ array)))))) (def: (type_to_class_name type) (-> Type (Meta Text)) (if (type\= Any type) - (\ meta.monad wrap "java.lang.Object") + (\ meta.monad in "java.lang.Object") (case type (#.Primitive name params) - (\ meta.monad wrap name) + (\ meta.monad in name) (#.Apply A F) (case (type.applied (list A) F) @@ -1768,12 +1768,12 @@ (case array [_ (#.Identifier array_name)] (do meta.monad - [array_type (meta.find_type array_name) + [array_type (meta.type array_name) array_jvm_type (type_to_class_name array_type)] (case array_jvm_type (^template [<type> <array_op>] [<type> - (wrap (list (` (<array_op> (~ array) (~ idx)))))]) + (in (list (` (<array_op> (~ array) (~ idx)))))]) (["[Z" "jvm zaload"] ["[B" "jvm baload"] ["[S" "jvm saload"] @@ -1784,12 +1784,12 @@ ["[C" "jvm caload"]) _ - (wrap (list (` ("jvm aaload" (~ array) (~ idx))))))) + (in (list (` ("jvm aaload" (~ array) (~ idx))))))) _ (with_gensyms [g!array] - (wrap (list (` (let [(~ g!array) (~ array)] - (..array_read (~ idx) (~ g!array))))))))) + (in (list (` (let [(~ g!array) (~ array)] + (..array_read (~ idx) (~ g!array))))))))) (syntax: #export (array_write idx value array) {#.doc (doc "Stores an element into an array." @@ -1797,12 +1797,12 @@ (case array [_ (#.Identifier array_name)] (do meta.monad - [array_type (meta.find_type array_name) + [array_type (meta.type array_name) array_jvm_type (type_to_class_name array_type)] (case array_jvm_type (^template [<type> <array_op>] [<type> - (wrap (list (` (<array_op> (~ array) (~ idx) (~ value)))))]) + (in (list (` (<array_op> (~ array) (~ idx) (~ value)))))]) (["[Z" "jvm zastore"] ["[B" "jvm bastore"] ["[S" "jvm sastore"] @@ -1813,17 +1813,17 @@ ["[C" "jvm castore"]) _ - (wrap (list (` ("jvm aastore" (~ array) (~ idx) (~ value))))))) + (in (list (` ("jvm aastore" (~ array) (~ idx) (~ value))))))) _ (with_gensyms [g!array] - (wrap (list (` (let [(~ g!array) (~ array)] - (..array_write (~ idx) (~ value) (~ g!array))))))))) + (in (list (` (let [(~ g!array) (~ array)] + (..array_write (~ idx) (~ value) (~ g!array))))))))) (syntax: #export (class_for {type (..generic_type^ (list))}) {#.doc (doc "Loads the class as a java.lang.Class object." (class_for java/lang/String))} - (wrap (list (` ("jvm object class" (~ (code.text (simple_class$ (list) type)))))))) + (in (list (` ("jvm object class" (~ (code.text (simple_class$ (list) type)))))))) (syntax: #export (type {type (..generic_type^ (list))}) - (wrap (list (..class_to_type #ManualPrM (list) type)))) + (in (list (..class_to_type #ManualPrM (list) type)))) diff --git a/stdlib/source/library/lux/ffi.php.lux b/stdlib/source/library/lux/ffi.php.lux index eb9b5fbed..c9a0a584c 100644 --- a/stdlib/source/library/lux/ffi.php.lux +++ b/stdlib/source/library/lux/ffi.php.lux @@ -80,7 +80,7 @@ (def: constant (Parser Field) (<code>.form ($_ <>.and - (<>\wrap true) + (<>\in true) <code>.local_identifier (<>.maybe ..alias) ..nullable))) @@ -189,7 +189,7 @@ (#.Left error) (recover_from_failure error)))} - (wrap (list (` ("lux try" ((~! io.io) (~ expression))))))) + (in (list (` ("lux try" ((~! io.io) (~ expression))))))) (def: (with_io with? without) (-> Bit Code Code) @@ -245,70 +245,70 @@ code.local_identifier))) g!type (code.local_identifier (maybe.default class alias)) class_import (` ("php constant" (~ (code.text class))))] - (wrap (list& (` (type: (~ g!type) - (..Object (primitive (~ (code.text class)))))) - (list\map (function (_ member) - (case member - (#Field [static? field alias fieldT]) - (if static? - (` ((~! syntax:) ((~ (qualify (maybe.default field alias)))) - (\ (~! meta.monad) (~' wrap) - (list (` (.:as (~ (nullable_type fieldT)) - ("php constant" (~ (code.text (%.format class "::" field)))))))))) - (` (def: ((~ (qualify field)) + (in (list& (` (type: (~ g!type) + (..Object (primitive (~ (code.text class)))))) + (list\map (function (_ member) + (case member + (#Field [static? field alias fieldT]) + (if static? + (` ((~! syntax:) ((~ (qualify (maybe.default field alias)))) + (\ (~! meta.monad) (~' in) + (list (` (.:as (~ (nullable_type fieldT)) + ("php constant" (~ (code.text (%.format class "::" field)))))))))) + (` (def: ((~ (qualify field)) + (~ g!object)) + (-> (~ g!type) + (~ (nullable_type fieldT))) + (:assume + (~ (without_null g!temp fieldT (` ("php object get" (~ (code.text field)) + (:as (..Object .Any) (~ g!object)))))))))) + + (#Method method) + (case method + (#Static [method alias inputsT io? try? outputT]) + (..make_function (qualify (maybe.default method alias)) + g!temp + (` ("php object get" (~ (code.text method)) + (:as (..Object .Any) + ("php constant" (~ (code.text (%.format class "::" method))))))) + inputsT + io? + try? + outputT) + + (#Virtual [method alias inputsT io? try? outputT]) + (let [g!inputs (input_variables inputsT)] + (` (def: ((~ (qualify (maybe.default method alias))) + [(~+ (list\map product.right g!inputs))] (~ g!object)) - (-> (~ g!type) - (~ (nullable_type fieldT))) + (-> [(~+ (list\map nullable_type inputsT))] + (~ g!type) + (~ (|> (nullable_type outputT) + (try_type try?) + (io_type io?)))) (:assume - (~ (without_null g!temp fieldT (` ("php object get" (~ (code.text field)) - (:as (..Object .Any) (~ g!object)))))))))) - - (#Method method) - (case method - (#Static [method alias inputsT io? try? outputT]) - (..make_function (qualify (maybe.default method alias)) - g!temp - (` ("php object get" (~ (code.text method)) - (:as (..Object .Any) - ("php constant" (~ (code.text (%.format class "::" method))))))) - inputsT - io? - try? - outputT) - - (#Virtual [method alias inputsT io? try? outputT]) - (let [g!inputs (input_variables inputsT)] - (` (def: ((~ (qualify (maybe.default method alias))) - [(~+ (list\map product.right g!inputs))] - (~ g!object)) - (-> [(~+ (list\map nullable_type inputsT))] - (~ g!type) - (~ (|> (nullable_type outputT) - (try_type try?) - (io_type io?)))) - (:assume - (~ (<| (with_io io?) - (with_try try?) - (without_null g!temp outputT) - (` ("php object do" - (~ (code.text method)) - (~ g!object) - (~+ (list\map (with_null g!temp) g!inputs))))))))))))) - members))))) + (~ (<| (with_io io?) + (with_try try?) + (without_null g!temp outputT) + (` ("php object do" + (~ (code.text method)) + (~ g!object) + (~+ (list\map (with_null g!temp) g!inputs))))))))))))) + members))))) (#Function [name alias inputsT io? try? outputT]) (let [imported (` ("php constant" (~ (code.text name))))] - (wrap (list (..make_function (code.local_identifier (maybe.default name alias)) - g!temp - imported - inputsT - io? - try? - outputT)))) + (in (list (..make_function (code.local_identifier (maybe.default name alias)) + g!temp + imported + inputsT + io? + try? + outputT)))) (#Constant [_ name alias fieldT]) (let [imported (` ("php constant" (~ (code.text name))))] - (wrap (list (` ((~! syntax:) ((~ (code.local_identifier (maybe.default name alias)))) - (\ (~! meta.monad) (~' wrap) - (list (` (.:as (~ (nullable_type fieldT)) (~ imported)))))))))) + (in (list (` ((~! syntax:) ((~ (code.local_identifier (maybe.default name alias)))) + (\ (~! meta.monad) (~' in) + (list (` (.:as (~ (nullable_type fieldT)) (~ imported)))))))))) ))) diff --git a/stdlib/source/library/lux/ffi.py.lux b/stdlib/source/library/lux/ffi.py.lux index 36196c8dc..150cbf578 100644 --- a/stdlib/source/library/lux/ffi.py.lux +++ b/stdlib/source/library/lux/ffi.py.lux @@ -235,76 +235,76 @@ #.Nil (` ("python import" (~ (code.text class)))))] - (wrap (list& (` (type: (~ g!type) - (..Object (primitive (~ (code.text real_class)))))) - (list\map (function (_ member) - (case member - (#Constructor inputsT) - (let [g!inputs (input_variables inputsT)] - (` (def: ((~ (qualify "new")) - [(~+ (list\map product.right g!inputs))]) - (-> [(~+ (list\map noneable_type inputsT))] - (~ g!type)) - (:assume - ("python apply" - (:as ..Function (~ imported)) - (~+ (list\map (with_none g!temp) g!inputs))))))) + (in (list& (` (type: (~ g!type) + (..Object (primitive (~ (code.text real_class)))))) + (list\map (function (_ member) + (case member + (#Constructor inputsT) + (let [g!inputs (input_variables inputsT)] + (` (def: ((~ (qualify "new")) + [(~+ (list\map product.right g!inputs))]) + (-> [(~+ (list\map noneable_type inputsT))] + (~ g!type)) + (:assume + ("python apply" + (:as ..Function (~ imported)) + (~+ (list\map (with_none g!temp) g!inputs))))))) + + (#Field [static? field fieldT]) + (if static? + (` ((~! syntax:) ((~ (qualify field))) + (\ (~! meta.monad) (~' in) + (list (` (.:as (~ (noneable_type fieldT)) + ("python object get" (~ (code.text field)) + (:as (..Object .Any) (~ imported))))))))) + (` (def: ((~ (qualify field)) + (~ g!object)) + (-> (~ g!type) + (~ (noneable_type fieldT))) + (:assume + (~ (without_none g!temp fieldT (` ("python object get" (~ (code.text field)) + (:as (..Object .Any) (~ g!object)))))))))) + + (#Method method) + (case method + (#Static [method alias inputsT io? try? outputT]) + (..make_function (qualify (maybe.default method alias)) + g!temp + (` ("python object get" (~ (code.text method)) + (:as (..Object .Any) (~ imported)))) + inputsT + io? + try? + outputT) - (#Field [static? field fieldT]) - (if static? - (` ((~! syntax:) ((~ (qualify field))) - (\ (~! meta.monad) (~' wrap) - (list (` (.:as (~ (noneable_type fieldT)) - ("python object get" (~ (code.text field)) - (:as (..Object .Any) (~ imported))))))))) - (` (def: ((~ (qualify field)) + (#Virtual [method alias inputsT io? try? outputT]) + (let [g!inputs (input_variables inputsT)] + (` (def: ((~ (qualify (maybe.default method alias))) + [(~+ (list\map product.right g!inputs))] (~ g!object)) - (-> (~ g!type) - (~ (noneable_type fieldT))) + (-> [(~+ (list\map noneable_type inputsT))] + (~ g!type) + (~ (|> (noneable_type outputT) + (try_type try?) + (io_type io?)))) (:assume - (~ (without_none g!temp fieldT (` ("python object get" (~ (code.text field)) - (:as (..Object .Any) (~ g!object)))))))))) - - (#Method method) - (case method - (#Static [method alias inputsT io? try? outputT]) - (..make_function (qualify (maybe.default method alias)) - g!temp - (` ("python object get" (~ (code.text method)) - (:as (..Object .Any) (~ imported)))) - inputsT - io? - try? - outputT) - - (#Virtual [method alias inputsT io? try? outputT]) - (let [g!inputs (input_variables inputsT)] - (` (def: ((~ (qualify (maybe.default method alias))) - [(~+ (list\map product.right g!inputs))] - (~ g!object)) - (-> [(~+ (list\map noneable_type inputsT))] - (~ g!type) - (~ (|> (noneable_type outputT) - (try_type try?) - (io_type io?)))) - (:assume - (~ (<| (with_io io?) - (with_try try?) - (without_none g!temp outputT) - (` ("python object do" - (~ (code.text method)) - (~ g!object) - (~+ (list\map (with_none g!temp) g!inputs))))))))))))) - members))))) + (~ (<| (with_io io?) + (with_try try?) + (without_none g!temp outputT) + (` ("python object do" + (~ (code.text method)) + (~ g!object) + (~+ (list\map (with_none g!temp) g!inputs))))))))))))) + members))))) (#Function [name alias inputsT io? try? outputT]) - (wrap (list (..make_function (code.local_identifier (maybe.default name alias)) - g!temp - (` ("python constant" (~ (code.text name)))) - inputsT - io? - try? - outputT))) + (in (list (..make_function (code.local_identifier (maybe.default name alias)) + g!temp + (` ("python constant" (~ (code.text name)))) + inputsT + io? + try? + outputT))) ))) (template: #export (lambda <inputs> <output>) diff --git a/stdlib/source/library/lux/ffi.rb.lux b/stdlib/source/library/lux/ffi.rb.lux index f3f483e23..ba63ac1b1 100644 --- a/stdlib/source/library/lux/ffi.rb.lux +++ b/stdlib/source/library/lux/ffi.rb.lux @@ -80,7 +80,7 @@ (def: constant (Parser Field) (<code>.form ($_ <>.and - (<>\wrap true) + (<>\in true) <code>.local_identifier (<>.maybe ..alias) ..nilable))) @@ -245,60 +245,60 @@ #.None (list))) class_import (` ("ruby constant" (~ (code.text class))))] - (wrap (list& (` (type: (~ g!type) - (..Object (primitive (~ (code.text class)))))) - (list\map (function (_ member) - (case member - (#Field [static? field alias fieldT]) - (if static? - (` ((~! syntax:) ((~ (qualify (maybe.default field alias)))) - (\ (~! meta.monad) (~' wrap) - (list (` (.:as (~ (nilable_type fieldT)) - (.exec - (~+ module_import) - ("ruby constant" (~ (code.text (%.format class "::" field))))))))))) - (` (def: ((~ (qualify field)) + (in (list& (` (type: (~ g!type) + (..Object (primitive (~ (code.text class)))))) + (list\map (function (_ member) + (case member + (#Field [static? field alias fieldT]) + (if static? + (` ((~! syntax:) ((~ (qualify (maybe.default field alias)))) + (\ (~! meta.monad) (~' in) + (list (` (.:as (~ (nilable_type fieldT)) + (.exec + (~+ module_import) + ("ruby constant" (~ (code.text (%.format class "::" field))))))))))) + (` (def: ((~ (qualify field)) + (~ g!object)) + (-> (~ g!type) + (~ (nilable_type fieldT))) + (:assume + (~ (without_nil g!temp fieldT (` ("ruby object get" (~ (code.text field)) + (:as (..Object .Any) (~ g!object)))))))))) + + (#Method method) + (case method + (#Static [method alias inputsT io? try? outputT]) + (..make_function (qualify (maybe.default method alias)) + g!temp + (` ("ruby object get" (~ (code.text method)) + (:as (..Object .Any) + (.exec + (~+ module_import) + ("ruby constant" (~ (code.text (%.format class "::" method)))))))) + inputsT + io? + try? + outputT) + + (#Virtual [method alias inputsT io? try? outputT]) + (let [g!inputs (input_variables inputsT)] + (` (def: ((~ (qualify (maybe.default method alias))) + [(~+ (list\map product.right g!inputs))] (~ g!object)) - (-> (~ g!type) - (~ (nilable_type fieldT))) + (-> [(~+ (list\map nilable_type inputsT))] + (~ g!type) + (~ (|> (nilable_type outputT) + (try_type try?) + (io_type io?)))) (:assume - (~ (without_nil g!temp fieldT (` ("ruby object get" (~ (code.text field)) - (:as (..Object .Any) (~ g!object)))))))))) - - (#Method method) - (case method - (#Static [method alias inputsT io? try? outputT]) - (..make_function (qualify (maybe.default method alias)) - g!temp - (` ("ruby object get" (~ (code.text method)) - (:as (..Object .Any) - (.exec - (~+ module_import) - ("ruby constant" (~ (code.text (%.format class "::" method)))))))) - inputsT - io? - try? - outputT) - - (#Virtual [method alias inputsT io? try? outputT]) - (let [g!inputs (input_variables inputsT)] - (` (def: ((~ (qualify (maybe.default method alias))) - [(~+ (list\map product.right g!inputs))] - (~ g!object)) - (-> [(~+ (list\map nilable_type inputsT))] - (~ g!type) - (~ (|> (nilable_type outputT) - (try_type try?) - (io_type io?)))) - (:assume - (~ (<| (with_io io?) - (with_try try?) - (without_nil g!temp outputT) - (` ("ruby object do" - (~ (code.text method)) - (~ g!object) - (~+ (list\map (with_nil g!temp) g!inputs))))))))))))) - members))))) + (~ (<| (with_io io?) + (with_try try?) + (without_nil g!temp outputT) + (` ("ruby object do" + (~ (code.text method)) + (~ g!object) + (~+ (list\map (with_nil g!temp) g!inputs))))))))))))) + members))))) (#Function [name alias inputsT io? try? outputT]) (let [imported (` (.exec @@ -309,13 +309,13 @@ #.None (list))) ("ruby constant" (~ (code.text name)))))] - (wrap (list (..make_function (code.local_identifier (maybe.default name alias)) - g!temp - imported - inputsT - io? - try? - outputT)))) + (in (list (..make_function (code.local_identifier (maybe.default name alias)) + g!temp + imported + inputsT + io? + try? + outputT)))) (#Constant [_ name alias fieldT]) (let [imported (` (.exec @@ -326,7 +326,7 @@ #.None (list))) ("ruby constant" (~ (code.text name)))))] - (wrap (list (` ((~! syntax:) ((~ (code.local_identifier (maybe.default name alias)))) - (\ (~! meta.monad) (~' wrap) - (list (` (.:as (~ (nilable_type fieldT)) (~ imported)))))))))) + (in (list (` ((~! syntax:) ((~ (code.local_identifier (maybe.default name alias)))) + (\ (~! meta.monad) (~' in) + (list (` (.:as (~ (nilable_type fieldT)) (~ imported)))))))))) ))) diff --git a/stdlib/source/library/lux/ffi.scm.lux b/stdlib/source/library/lux/ffi.scm.lux index 85370fcf6..69559353f 100644 --- a/stdlib/source/library/lux/ffi.scm.lux +++ b/stdlib/source/library/lux/ffi.scm.lux @@ -80,7 +80,7 @@ (def: constant (Parser Field) (<code>.form ($_ <>.and - (<>\wrap true) + (<>\in true) <code>.local_identifier (<>.maybe ..alias) ..nilable))) @@ -156,7 +156,7 @@ (#.Left error) (recover_from_failure error)))} - (wrap (list (` ("lux try" ((~! io.io) (~ expression))))))) + (in (list (` ("lux try" ((~! io.io) (~ expression))))))) (def: (with_io with? without) (-> Bit Code Code) @@ -204,17 +204,17 @@ (case import (#Function [name alias inputsT io? try? outputT]) (let [imported (` ("scheme constant" (~ (code.text name))))] - (wrap (list (..make_function (code.local_identifier (maybe.default name alias)) - g!temp - imported - inputsT - io? - try? - outputT)))) + (in (list (..make_function (code.local_identifier (maybe.default name alias)) + g!temp + imported + inputsT + io? + try? + outputT)))) (#Constant [_ name alias fieldT]) (let [imported (` ("scheme constant" (~ (code.text name))))] - (wrap (list (` ((~! syntax:) ((~ (code.local_identifier (maybe.default name alias)))) - (\ (~! meta.monad) (~' wrap) - (list (` (.:as (~ (nilable_type fieldT)) (~ imported)))))))))) + (in (list (` ((~! syntax:) ((~ (code.local_identifier (maybe.default name alias)))) + (\ (~! meta.monad) (~' in) + (list (` (.:as (~ (nilable_type fieldT)) (~ imported)))))))))) ))) diff --git a/stdlib/source/library/lux/macro.lux b/stdlib/source/library/lux/macro.lux index 275401a61..242ed8a85 100644 --- a/stdlib/source/library/lux/macro.lux +++ b/stdlib/source/library/lux/macro.lux @@ -25,16 +25,16 @@ (case syntax [_ (#.Form (#.Cons [[_ (#.Identifier name)] args]))] (do //.monad - [?macro (//.find_macro name)] + [?macro (//.macro name)] (case ?macro (#.Some macro) ((:as Macro' macro) args) #.None - (\ //.monad wrap (list syntax)))) + (\ //.monad in (list syntax)))) _ - (\ //.monad wrap (list syntax)))) + (\ //.monad in (list syntax)))) (def: #export (expand syntax) {#.doc (doc "Given code that requires applying a macro, expands repeatedly until no more direct macro-calls are left." @@ -43,19 +43,19 @@ (case syntax [_ (#.Form (#.Cons [[_ (#.Identifier name)] args]))] (do //.monad - [?macro (//.find_macro name)] + [?macro (//.macro name)] (case ?macro (#.Some macro) (do //.monad [expansion ((:as Macro' macro) args) expansion' (monad.map //.monad expand expansion)] - (wrap (list\join expansion'))) + (in (list\join expansion'))) #.None - (\ //.monad wrap (list syntax)))) + (\ //.monad in (list syntax)))) _ - (\ //.monad wrap (list syntax)))) + (\ //.monad in (list syntax)))) (def: #export (expand_all syntax) {#.doc "Expands all macro-calls everywhere recursively, until only primitive/base code remains."} @@ -63,29 +63,29 @@ (case syntax [_ (#.Form (#.Cons [[_ (#.Identifier name)] args]))] (do //.monad - [?macro (//.find_macro name)] + [?macro (//.macro name)] (case ?macro (#.Some macro) (do //.monad [expansion ((:as Macro' macro) args) expansion' (monad.map //.monad expand_all expansion)] - (wrap (list\join expansion'))) + (in (list\join expansion'))) #.None (do //.monad [parts' (monad.map //.monad expand_all (list& (code.identifier name) args))] - (wrap (list (code.form (list\join parts'))))))) + (in (list (code.form (list\join parts'))))))) [_ (#.Form (#.Cons [harg targs]))] (do //.monad [harg+ (expand_all harg) targs+ (monad.map //.monad expand_all targs)] - (wrap (list (code.form (list\compose harg+ (list\join (: (List (List Code)) targs+))))))) + (in (list (code.form (list\compose harg+ (list\join (: (List (List Code)) targs+))))))) [_ (#.Tuple members)] (do //.monad [members' (monad.map //.monad expand_all members)] - (wrap (list (code.tuple (list\join members'))))) + (in (list (code.tuple (list\join members'))))) [_ (#.Record members)] (|> members @@ -96,14 +96,14 @@ right (expand_all right)] (case [left right] [(#.Cons left #.Nil) (#.Cons right #.Nil)] - (wrap [left right]) + (in [left right]) _ (//.failure "Record members must expand into singletons."))))) (\ //.monad map (|>> code.record list))) _ - (\ //.monad wrap (list syntax)))) + (\ //.monad in (list syntax)))) (def: #export (gensym prefix) {#.doc (doc "Generates a unique name as an Code node (ready to be used in code templates)." @@ -111,16 +111,16 @@ (-> Text (Meta Code)) (do //.monad [id //.count] - (wrap (|> id - (\ nat.decimal encode) - ($_ text\compose "__gensym__" prefix) - [""] code.identifier)))) + (in (|> id + (\ nat.decimal encode) + ($_ text\compose "__gensym__" prefix) + [""] code.identifier)))) (def: (get_local_identifier ast) (-> Code (Meta Text)) (case ast [_ (#.Identifier [_ name])] - (\ //.monad wrap name) + (\ //.monad in name) _ (//.failure (text\compose "Code is not a local identifier: " (code.format ast))))) @@ -134,11 +134,11 @@ {#.doc (doc "Creates new identifiers and offers them to the body expression." (syntax: #export (synchronized lock body) (with_gensyms [g!lock g!body g!_] - (wrap (list (` (let [(~ g!lock) (~ lock) - (~ g!_) ("jvm monitorenter" (~ g!lock)) - (~ g!body) (~ body) - (~ g!_) ("jvm monitorexit" (~ g!lock))] - (~ g!body))))) + (in (list (` (let [(~ g!lock) (~ lock) + (~ g!_) ("jvm monitorenter" (~ g!lock)) + (~ g!body) (~ body) + (~ g!_) ("jvm monitorexit" (~ g!lock))] + (~ g!body))))) )))} (case tokens (^ (list [_ (#.Tuple identifiers)] body)) @@ -147,9 +147,9 @@ #let [identifier_defs (list\join (list\map (: (-> Text (List Code)) (function (_ name) (list (code.identifier ["" name]) (` (gensym (~ (code.text name))))))) identifier_names))]] - (wrap (list (` ((~! do) (~! //.monad) - [(~+ identifier_defs)] - (~ body)))))) + (in (list (` ((~! do) (~! //.monad) + [(~+ identifier_defs)] + (~ body)))))) _ (//.failure (..wrong_syntax_error (name_of ..with_gensyms))))) @@ -161,7 +161,7 @@ [token+ (..expand token)] (case token+ (^ (list token')) - (wrap token') + (in token') _ (//.failure "Macro expanded to more than 1 element.")))) @@ -197,9 +197,9 @@ _ (list\map (|>> code.format "lux io log") output) _ ("lux io log" "")]] - (wrap (if omit? - (list) - output))) + (in (if omit? + (list) + output))) #.None (//.failure (..wrong_syntax_error macro_name)))))] diff --git a/stdlib/source/library/lux/macro/local.lux b/stdlib/source/library/lux/macro/local.lux index 1fc16815f..3e37d174f 100644 --- a/stdlib/source/library/lux/macro/local.lux +++ b/stdlib/source/library/lux/macro/local.lux @@ -45,7 +45,7 @@ (#try.Failure error)) #.None - (exception.throw ..unknown_module [name])))) + (exception.except ..unknown_module [name])))) (def: (push_one [name macro]) (-> [Name Macro] (Meta Any)) @@ -62,7 +62,7 @@ []]) (#.Some _) - (exception.throw ..cannot_shadow_definition [module_name definition_name])))))) + (exception.except ..cannot_shadow_definition [module_name definition_name])))))) (def: (pop_one name) (-> Name (Meta Any)) @@ -78,7 +78,7 @@ []]) #.None - (exception.throw ..unknown_definition [module_name definition_name])))))) + (exception.except ..unknown_definition [module_name definition_name])))))) (def: (pop_all macros self) (-> (List Name) Name Macro) @@ -88,12 +88,12 @@ [_ (monad.map ! ..pop_one macros) _ (..pop_one self) compiler meta.get_compiler] - (wrap (case (get@ #.expected compiler) - (#.Some _) - (list (' [])) - - #.None - (list))))))) + (in (case (get@ #.expected compiler) + (#.Some _) + (list (' [])) + + #.None + (list))))))) (def: #export (push macros) (-> (List [Name Macro]) (Meta Code)) @@ -103,4 +103,4 @@ 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)))))) + (in (` ((~ g!pop)))))) diff --git a/stdlib/source/library/lux/macro/poly.lux b/stdlib/source/library/lux/macro/poly.lux index a9f4a5744..892f23284 100644 --- a/stdlib/source/library/lux/macro/poly.lux +++ b/stdlib/source/library/lux/macro/poly.lux @@ -29,19 +29,19 @@ body) (with_gensyms [g!_ g!type g!output] (let [g!name (code.identifier ["" name])] - (wrap (.list (` ((~! syntax:) (~+ (|export|.format export)) ((~ g!name) {(~ g!type) (~! <code>.identifier)}) - ((~! do) (~! meta.monad) - [(~ g!type) ((~! meta.find_type_def) (~ g!type))] - (case (: (.Either .Text .Code) - ((~! <type>.run) ((~! <>.rec) - (function ((~ g!_) (~ g!name)) - (~ body))) - (~ g!type))) - (#.Left (~ g!output)) - ((~! meta.failure) (~ g!output)) + (in (.list (` ((~! syntax:) (~+ (|export|.format export)) ((~ g!name) {(~ g!type) (~! <code>.identifier)}) + ((~! do) (~! meta.monad) + [(~ g!type) ((~! meta.type_definition) (~ g!type))] + (case (: (.Either .Text .Code) + ((~! <type>.run) ((~! <>.rec) + (function ((~ g!_) (~ g!name)) + (~ body))) + (~ g!type))) + (#.Left (~ g!output)) + ((~! meta.failure) (~ g!output)) - (#.Right (~ g!output)) - ((~' wrap) (.list (~ g!output)))))))))))) + (#.Right (~ g!output)) + ((~' in) (.list (~ g!output)))))))))))) (def: (common_poly_name? poly_func) (-> Text Bit) @@ -61,12 +61,12 @@ [poly_args (monad.map ! meta.normal poly_args) name (case ?name (#.Some name) - (wrap name) + (in name) (^multi #.None {(derivation_name (product.right poly_func) (list\map product.right poly_args)) (#.Some derived_name)}) - (wrap derived_name) + (in derived_name) _ (<>.failure "derived: was given no explicit name, and cannot generate one from given information.")) @@ -76,10 +76,10 @@ #.None (` ((~ (code.identifier poly_func)) (~+ (list\map code.identifier poly_args)))))]] - (wrap (.list (` (def: (~+ (|export|.format export)) - (~ (code.identifier ["" name])) - {#.implementation? #1} - (~ impl))))))) + (in (.list (` (def: (~+ (|export|.format export)) + (~ (code.identifier ["" name])) + {#.implementation? #1} + (~ impl))))))) (def: #export (to_code env type) (-> Env Type Code) diff --git a/stdlib/source/library/lux/macro/syntax.lux b/stdlib/source/library/lux/macro/syntax.lux index 3ad402530..1ba0c4f9f 100644 --- a/stdlib/source/library/lux/macro/syntax.lux +++ b/stdlib/source/library/lux/macro/syntax.lux @@ -57,7 +57,7 @@ (with_brackets (spaced (list\map super_class_decl$ interfaces))) (with_brackets (spaced (list\map constructor_arg$ constructor_args))) (with_brackets (spaced (list\map (method_def$ id) methods))))))] - (wrap (list (` ((~ (code.text def_code)))))))))} + (in (list (` ((~ (code.text def_code)))))))))} (let [[exported? tokens] (: [Bit (List Code)] (case tokens (^ (list& [_ (#.Tag ["" "export"])] tokens')) @@ -89,17 +89,17 @@ (^ [_ (#.Record (list [var parser]))]) (case var [_ (#.Tag ["" "let"])] - (wrap [var parser]) + (in [var parser]) _ - (wrap [var - (` ((~! ..self_documenting) (' (~ var)) - (~ parser)))])) + (in [var + (` ((~! ..self_documenting) (' (~ var)) + (~ parser)))])) [_ (#.Identifier var_name)] - (wrap [arg - (` ((~! ..self_documenting) (' (~ arg)) - (~! </>.any)))]) + (in [arg + (` ((~! ..self_documenting) (' (~ arg)) + (~! </>.any)))]) _ (meta.failure "Syntax pattern expects records or identifiers.")))) @@ -111,19 +111,19 @@ (if exported? (list (' #export)) (list)))]] - (wrap (list (` (macro: (~+ export_ast) ((~ (code.identifier ["" name])) (~ g!tokens) (~ g!state)) - (~ meta) - ({(#.Right (~ g!body)) - ((~ g!body) (~ g!state)) + (in (list (` (macro: (~+ export_ast) ((~ (code.identifier ["" name])) (~ g!tokens) (~ g!state)) + (~ meta) + ({(#.Right (~ g!body)) + ((~ g!body) (~ g!state)) - (#.Left (~ g!error)) - (#.Left ((~! text.join_with) (~! text.new_line) (list (~ error_msg) (~ g!error))))} - ((~! </>.run) - (: ((~! </>.Parser) (Meta (List Code))) - ((~! do) (~! <>.monad) - [(~+ (..join_pairs vars+parsers))] - ((~' wrap) (~ body)))) - (~ g!tokens))))))))) + (#.Left (~ g!error)) + (#.Left ((~! text.join_with) (~! text.new_line) (list (~ error_msg) (~ g!error))))} + ((~! </>.run) + (: ((~! </>.Parser) (Meta (List Code))) + ((~! do) (~! <>.monad) + [(~+ (..join_pairs vars+parsers))] + ((~' in) (~ body)))) + (~ g!tokens))))))))) _ (meta.failure (macro.wrong_syntax_error (name_of ..syntax:)))))) diff --git a/stdlib/source/library/lux/macro/syntax/declaration.lux b/stdlib/source/library/lux/macro/syntax/declaration.lux index d1c7d94c6..75098a7b9 100644 --- a/stdlib/source/library/lux/macro/syntax/declaration.lux +++ b/stdlib/source/library/lux/macro/syntax/declaration.lux @@ -32,7 +32,7 @@ (foo bar baz))} (Parser Declaration) (<>.either (<>.and <code>.local_identifier - (<>\wrap (list))) + (<>\in (list))) (<code>.form (<>.and <code>.local_identifier (<>.some <code>.local_identifier))))) diff --git a/stdlib/source/library/lux/macro/syntax/definition.lux b/stdlib/source/library/lux/macro/syntax/definition.lux index 7f9e9583f..a97abb278 100644 --- a/stdlib/source/library/lux/macro/syntax/definition.lux +++ b/stdlib/source/library/lux/macro/syntax/definition.lux @@ -96,7 +96,7 @@ [_ (<code>.tag! (name_of #.Cons)) [head tail] (<>.and (<code>.tuple (<>.and tag_parser <code>.any)) recur)] - (wrap [head tail]))) + (in [head tail]))) )))) (def: #export (parser compiler) @@ -134,8 +134,8 @@ [definition (..parser compiler) _ (case (get@ #value definition) (#.Left _) - (wrap []) + (in []) (#.Right _) - (<>.lift (exception.throw ..lacks_type! [definition])))] - (wrap definition))) + (<>.lift (exception.except ..lacks_type! [definition])))] + (in definition))) diff --git a/stdlib/source/library/lux/macro/syntax/export.lux b/stdlib/source/library/lux/macro/syntax/export.lux index d76aa6fcc..d51b28bcd 100644 --- a/stdlib/source/library/lux/macro/syntax/export.lux +++ b/stdlib/source/library/lux/macro/syntax/export.lux @@ -17,5 +17,5 @@ (def: #export parser (Parser Bit) (<>.either (<>.after (<code>.this! ..token) - (<>\wrap true)) - (<>\wrap false))) + (<>\in true)) + (<>\in false))) diff --git a/stdlib/source/library/lux/macro/template.lux b/stdlib/source/library/lux/macro/template.lux index c835b8fd9..09204ce76 100644 --- a/stdlib/source/library/lux/macro/template.lux +++ b/stdlib/source/library/lux/macro/template.lux @@ -27,10 +27,10 @@ ["." local]]) (syntax: #export (spliced {parts (<code>.tuple (<>.some <code>.any))}) - (wrap parts)) + (in parts)) (syntax: #export (amount {parts (<code>.tuple (<>.some <code>.any))}) - (wrap (list (code.nat (list.size parts))))) + (in (list (code.nat (list.size parts))))) (syntax: #export (with_locals {locals (<code>.tuple (<>.some <code>.local_identifier))} body) @@ -38,21 +38,21 @@ [g!locals (|> locals (list\map //.gensym) (monad.seq !))] - (wrap (list (` (.with_expansions [(~+ (|> (list.zipped/2 locals g!locals) - (list\map (function (_ [name identifier]) - (list (code.local_identifier name) (as_is identifier)))) - list\join))] - (~ body))))))) + (in (list (` (.with_expansions [(~+ (|> (list.zipped/2 locals g!locals) + (list\map (function (_ [name identifier]) + (list (code.local_identifier name) (as_is identifier)))) + list\join))] + (~ body))))))) (def: (name_side module_side? parser) (-> Bit (Parser Name) (Parser Text)) (do <>.monad [[module short] parser] - (wrap (if module_side? - (case module - "" short - _ module) - short)))) + (in (if module_side? + (case module + "" short + _ module) + short)))) (def: (snippet module_side?) (-> Bit (Parser Text)) @@ -80,18 +80,18 @@ (<code>.tuple (<>.many (..snippet module_side?)))) (syntax: #export (text {simple (..part false)}) - (wrap (list (|> simple (text.join_with "") code.text)))) + (in (list (|> simple (text.join_with "") code.text)))) (template [<name> <simple> <complex>] [(syntax: #export (<name> {name (<>.or (<>.and (..part true) (..part false)) (..part false))}) (case name (#.Left [simple complex]) - (wrap (list (<complex> [(text.join_with "" simple) - (text.join_with "" complex)]))) + (in (list (<complex> [(text.join_with "" simple) + (text.join_with "" complex)]))) (#.Right simple) - (wrap (list (|> simple (text.join_with "") <simple>)))))] + (in (list (|> simple (text.join_with "") <simple>)))))] [identifier code.local_identifier code.identifier] [tag code.local_tag code.tag] @@ -148,7 +148,7 @@ (|> (list.zipped/2 parameters inputs) (dictionary.of_list text.hash)))] (#.Right [compiler (list\map (..applied environment) template)])) - (exception.throw ..irregular_arguments [parameters_amount inputs_amount])))))) + (exception.except ..irregular_arguments [parameters_amount inputs_amount])))))) (def: local (Parser Local) @@ -156,9 +156,9 @@ [[name parameters] (<code>.form (<>.and <code>.local_identifier (<>.many <code>.local_identifier))) template (<code>.tuple (<>.some <code>.any))] - (wrap {#name name - #parameters parameters - #template template}))) + (in {#name name + #parameters parameters + #template template}))) (syntax: #export (let {locals (<code>.tuple (<>.some ..local))} body) @@ -178,8 +178,8 @@ locals))] (if expression? (//.with_gensyms [g!body] - (wrap (list (` (.let [(~ g!body) (~ body)] - (exec (~ g!pop) - (~ g!body))))))) - (wrap (list body - g!pop))))) + (in (list (` (.let [(~ g!body) (~ body)] + (exec (~ g!pop) + (~ g!body))))))) + (in (list body + g!pop))))) diff --git a/stdlib/source/library/lux/math/infix.lux b/stdlib/source/library/lux/math/infix.lux index a8fd881aa..a0db7975d 100644 --- a/stdlib/source/library/lux/math/infix.lux +++ b/stdlib/source/library/lux/math/infix.lux @@ -1,4 +1,5 @@ -(.module: {#.doc "Common mathematical constants and functions."} +(.module: + {#.doc "Common mathematical constants and functions."} [library [lux #* [abstract @@ -46,21 +47,21 @@ init_op <code>.any init_param infix^ steps (<>.some (<>.and <code>.any infix^))] - (wrap (product.right (list\fold (function (_ [op param] [subject [_subject _op _param]]) - [param [(#Binary _subject _op _param) - (` and) - (#Binary subject op param)]]) - [init_param [init_subject init_op init_param]] - steps)))) + (in (product.right (list\fold (function (_ [op param] [subject [_subject _op _param]]) + [param [(#Binary _subject _op _param) + (` and) + (#Binary subject op param)]]) + [init_param [init_subject init_op init_param]] + steps)))) (do <>.monad [init_subject infix^ init_op <code>.any init_param infix^ steps (<>.some (<>.and <code>.any infix^))] - (wrap (list\fold (function (_ [op param] [_subject _op _param]) - [(#Binary _subject _op _param) op param]) - [init_subject init_op init_param] - steps))) + (in (list\fold (function (_ [op param] [_subject _op _param]) + [(#Binary _subject _op _param) op param]) + [init_subject init_op init_param] + steps))) )) ))) @@ -93,4 +94,4 @@ "If you want your binary function to work well with it." "Then take the argument to the right (y) as your first argument," "and take the argument to the left (x) as your second argument.")} - (wrap (list (..to_prefix expr)))) + (in (list (..to_prefix expr)))) diff --git a/stdlib/source/library/lux/math/modular.lux b/stdlib/source/library/lux/math/modular.lux index 679666580..0657f48b5 100644 --- a/stdlib/source/library/lux/math/modular.lux +++ b/stdlib/source/library/lux/math/modular.lux @@ -77,7 +77,7 @@ [[value _ actual] ($_ <>.and intL (<text>.this ..separator) intL) _ (<>.assert (exception.construct ..incorrect_modulus [expected actual]) (i.= (//.divisor expected) actual))] - (wrap (..modular expected value)))))) + (in (..modular expected value)))))) (template [<name> <op>] [(def: #export (<name> reference subject) @@ -154,4 +154,4 @@ (if (//.= reference subject) (#try.Success (|>> ..value (..modular reference))) - (exception.throw ..moduli_are_not_equal [reference subject]))) + (exception.except ..moduli_are_not_equal [reference subject]))) diff --git a/stdlib/source/library/lux/math/modulus.lux b/stdlib/source/library/lux/math/modulus.lux index b607b6e6a..8f490d236 100644 --- a/stdlib/source/library/lux/math/modulus.lux +++ b/stdlib/source/library/lux/math/modulus.lux @@ -29,7 +29,7 @@ (def: #export (modulus value) (Ex [m] (-> Int (Try (Modulus m)))) (if (i.= +0 value) - (exception.throw ..zero_cannot_be_a_modulus []) + (exception.except ..zero_cannot_be_a_modulus []) (#try.Success (:abstraction value)))) (def: #export divisor @@ -53,4 +53,4 @@ (meta.lift (do try.monad [_ (..modulus divisor)] - (wrap (list (` ((~! try.assumed) (..modulus (~ (code.int divisor)))))))))) + (in (list (` ((~! try.assumed) (..modulus (~ (code.int divisor)))))))))) diff --git a/stdlib/source/library/lux/math/number/complex.lux b/stdlib/source/library/lux/math/number/complex.lux index cc2c6a4f1..c374519b9 100644 --- a/stdlib/source/library/lux/math/number/complex.lux +++ b/stdlib/source/library/lux/math/number/complex.lux @@ -1,4 +1,5 @@ -(.module: {#.doc "Complex arithmetic."} +(.module: + {#.doc "Complex arithmetic."} [library [lux #* ["." math] @@ -31,9 +32,9 @@ (complex real imaginary) "The imaginary part can be omitted if it's 0." (complex real))} - (wrap (list (` {#..real (~ real) - #..imaginary (~ (maybe.default (' +0.0) - ?imaginary))})))) + (in (list (` {#..real (~ real) + #..imaginary (~ (maybe.default (' +0.0) + ?imaginary))})))) (def: #export i (..complex +0.0 +1.0)) diff --git a/stdlib/source/library/lux/math/number/frac.lux b/stdlib/source/library/lux/math/number/frac.lux index 1b0e1e52a..7b6f4df5d 100644 --- a/stdlib/source/library/lux/math/number/frac.lux +++ b/stdlib/source/library/lux/math/number/frac.lux @@ -363,8 +363,8 @@ exponent (|> representation ("lux text clip" after_offset after_length) (\ codec decode))] - (wrap [("lux text clip" 0 split_index representation) - (//int.* <factor> (.int exponent))]))]) + (in [("lux text clip" 0 split_index representation) + (//int.* <factor> (.int exponent))]))]) ([+1 (^or [(#.Some split_index) #.None #.None #.None] [#.None (#.Some split_index) #.None #.None])] [-1 (^or [#.None #.None (#.Some split_index) #.None] @@ -405,8 +405,8 @@ decimal (|> mantissa ("lux text clip" after_offset after_length) (\ <nat> decode))] - (wrap [("lux text clip" 0 split_index mantissa) - decimal])) + (in [("lux text clip" 0 split_index mantissa) + decimal])) #.None (#try.Failure ("lux text concat" <error> representation))) @@ -415,11 +415,11 @@ 0 whole _ ("lux text concat" whole (\ <nat> encode decimal)))) #let [sign (if negative? 1 0)]] - (wrap (..of_bits - ($_ //i64.or - (//i64.left_shift ..sign_offset (.i64 sign)) - (//i64.left_shift ..mantissa_size (.i64 (//int.+ (.int ..double_bias) exponent))) - (//i64.clear ..mantissa_size (.i64 mantissa)))))) + (in (..of_bits + ($_ //i64.or + (//i64.left_shift ..sign_offset (.i64 sign)) + (//i64.left_shift ..mantissa_size (.i64 (//int.+ (.int ..double_bias) exponent))) + (//i64.clear ..mantissa_size (.i64 mantissa)))))) (#try.Failure ("lux text concat" <error> representation))))))] [binary //nat.binary //int.binary "Invalid binary syntax: "] diff --git a/stdlib/source/library/lux/math/number/ratio.lux b/stdlib/source/library/lux/math/number/ratio.lux index ca122b00d..3ad54b2bd 100644 --- a/stdlib/source/library/lux/math/number/ratio.lux +++ b/stdlib/source/library/lux/math/number/ratio.lux @@ -44,9 +44,9 @@ (ratio numerator denominator) "The denominator can be omitted if it is 1." (ratio numerator))} - (wrap (list (` ((~! ..normal) {#..numerator (~ numerator) - #..denominator (~ (maybe.default (' 1) - ?denominator))}))))) + (in (list (` ((~! ..normal) {#..numerator (~ numerator) + #..denominator (~ (maybe.default (' 1) + ?denominator))}))))) (def: #export (= parameter subject) (-> Ratio Ratio Bit) @@ -144,8 +144,8 @@ (do try.monad [numerator (n\decode num) denominator (n\decode denom)] - (wrap (normal {#numerator numerator - #denominator denominator}))) + (in (normal {#numerator numerator + #denominator denominator}))) #.None (#.Left (text\compose "Invalid syntax for ratio: " input))))) diff --git a/stdlib/source/library/lux/math/random.lux b/stdlib/source/library/lux/math/random.lux index 3c3cf9448..9df9cbc53 100644 --- a/stdlib/source/library/lux/math/random.lux +++ b/stdlib/source/library/lux/math/random.lux @@ -1,4 +1,5 @@ -(.module: {#.doc "Pseudo-random number generation (PRNG) algorithms."} +(.module: + {#.doc "Pseudo-random number generation (PRNG) algorithms."} [library [lux (#- or and list i64 nat int rev char) [abstract @@ -69,7 +70,7 @@ (def: &functor ..functor) - (def: (wrap a) + (def: (in a) (function (_ state) [state a])) @@ -84,7 +85,7 @@ (do ..monad [sample gen] (if (pred sample) - (wrap sample) + (in sample) (only pred gen)))) (def: #export (one check random) @@ -94,7 +95,7 @@ [sample random] (case (check sample) (#.Some output) - (wrap output) + (in output) #.None (one check random)))) @@ -106,7 +107,7 @@ [sample gen] (case (refiner sample) (#.Some refined) - (wrap refined) + (in refined) #.None (refine refiner gen)))) @@ -163,11 +164,11 @@ (def: #export (text char_gen size) (-> (Random Char) Nat (Random Text)) (if (n.= 0 size) - (\ ..monad wrap "") + (\ ..monad in "") (do ..monad [x char_gen xs (text char_gen (dec size))] - (wrap (text\compose (text.of_code x) xs))))) + (in (text\compose (text.of_code x) xs))))) (template [<name> <set>] [(def: #export <name> @@ -189,7 +190,7 @@ (do ..monad [left <gen> right <gen>] - (wrap (<ctor> left right))))] + (in (<ctor> left right))))] [ratio r.Ratio r.ratio ..nat] [complex c.Complex c.complex ..safe_frac] @@ -201,7 +202,7 @@ (do ..monad [=left left =right right] - (wrap [=left =right]))) + (in [=left =right]))) (def: #export (or left right) {#.doc "Heterogeneous alternative combinator."} @@ -211,10 +212,10 @@ (if ? (do ! [=left left] - (wrap (0 #0 =left))) + (in (0 #0 =left))) (do ! [=right right] - (wrap (0 #1 =right)))))) + (in (0 #1 =right)))))) (def: #export (either left right) {#.doc "Homogeneous alternative combinator."} @@ -239,8 +240,8 @@ (if some? (do ! [value value_gen] - (wrap (#.Some value))) - (wrap #.None)))) + (in (#.Some value))) + (in #.None)))) (template [<name> <type> <zero> <plus>] [(def: #export (<name> size value_gen) @@ -249,8 +250,8 @@ (do ..monad [x value_gen xs (<name> (dec size) value_gen)] - (wrap (<plus> x xs))) - (\ ..monad wrap <zero>)))] + (in (<plus> x xs))) + (\ ..monad in <zero>)))] [list List (.list) #.Cons] [row Row row.empty row.add] @@ -261,7 +262,7 @@ (All [a] (-> Nat (Random a) (Random (<type> a)))) (do ..monad [values (list size value_gen)] - (wrap (|> values <ctor>))))] + (in (|> values <ctor>))))] [array Array array.of_list] [queue Queue queue.of_list] @@ -278,9 +279,9 @@ [x value_gen #let [xs+ (set.add x xs)]] (if (n.= size (set.size xs+)) - (wrap xs+) + (in xs+) (recur []))))) - (\ ..monad wrap (set.new Hash<a>)))) + (\ ..monad in (set.new Hash<a>)))) (def: #export (dictionary Hash<a> size key_gen value_gen) (All [k v] (-> (Hash k) Nat (Random k) (Random v) (Random (Dictionary k v)))) @@ -293,9 +294,9 @@ v value_gen #let [kv+ (dictionary.put k v kv)]] (if (n.= size (dictionary.size kv+)) - (wrap kv+) + (in kv+) (recur []))))) - (\ ..monad wrap (dictionary.new Hash<a>)))) + (\ ..monad in (dictionary.new Hash<a>)))) (def: #export instant (Random Instant) @@ -316,29 +317,29 @@ (def: #export month (Random Month) (let [(^open "\.") ..monad] - (..either (..either (..either (\wrap #month.January) - (..either (\wrap #month.February) - (\wrap #month.March))) - (..either (\wrap #month.April) - (..either (\wrap #month.May) - (\wrap #month.June)))) - (..either (..either (\wrap #month.July) - (..either (\wrap #month.August) - (\wrap #month.September))) - (..either (\wrap #month.October) - (..either (\wrap #month.November) - (\wrap #month.December))))))) + (..either (..either (..either (\in #month.January) + (..either (\in #month.February) + (\in #month.March))) + (..either (\in #month.April) + (..either (\in #month.May) + (\in #month.June)))) + (..either (..either (\in #month.July) + (..either (\in #month.August) + (\in #month.September))) + (..either (\in #month.October) + (..either (\in #month.November) + (\in #month.December))))))) (def: #export day (Random Day) (let [(^open "\.") ..monad] - (..either (..either (\wrap #day.Sunday) - (..either (\wrap #day.Monday) - (\wrap #day.Tuesday))) - (..either (..either (\wrap #day.Wednesday) - (\wrap #day.Thursday)) - (..either (\wrap #day.Friday) - (\wrap #day.Saturday)))))) + (..either (..either (\in #day.Sunday) + (..either (\in #day.Monday) + (\in #day.Tuesday))) + (..either (..either (\in #day.Wednesday) + (\in #day.Thursday)) + (..either (\in #day.Friday) + (\in #day.Saturday)))))) (def: #export (run prng calc) (All [a] (-> PRNG (Random a) [PRNG a])) diff --git a/stdlib/source/library/lux/meta.lux b/stdlib/source/library/lux/meta.lux index 97cfe8c9e..ec154caaf 100644 --- a/stdlib/source/library/lux/meta.lux +++ b/stdlib/source/library/lux/meta.lux @@ -1,6 +1,7 @@ -(.module: {#.doc "Functions for extracting information from the state of the compiler."} +(.module: + {#.doc "Functions for extracting information from the state of the compiler."} [library - [lux #* + [lux (#- type) [abstract [functor (#+ Functor)] [apply (#+ Apply)] @@ -64,7 +65,7 @@ (def: &functor ..functor) - (def: (wrap x) + (def: (in x) (function (_ compiler) (#try.Success [compiler x]))) @@ -116,7 +117,7 @@ (function (_ state) (#try.Failure (location.with (get@ #.location state) error)))) -(def: #export (find_module name) +(def: #export (module name) (-> Text (Meta Module)) (function (_ compiler) (case (plist.get name (get@ #.modules compiler)) @@ -140,7 +141,7 @@ (Meta Module) (let [(^open "\.") ..monad] (|> ..current_module_name - (\map ..find_module) + (\map ..module) \join))) (def: (macro_type? type) @@ -160,12 +161,12 @@ ["" name] (do ..monad [module_name ..current_module_name] - (wrap [module_name name])) + (in [module_name name])) _ - (\ ..monad wrap name))) + (\ ..monad in name))) -(def: (find_macro' modules this_module module name) +(def: (macro' modules this_module module name) (-> (List [Text Module]) Text Text Text (Maybe Macro)) (do maybe.monad @@ -176,14 +177,14 @@ (plist.get name)))] (case definition (#.Alias [r_module r_name]) - (find_macro' modules this_module r_module r_name) + (macro' modules this_module r_module r_name) (#.Definition [exported? def_type def_anns def_value]) (if (macro_type? def_type) (#.Some (:as Macro def_value)) #.None)))) -(def: #export (find_macro full_name) +(def: #export (macro full_name) (-> Name (Meta (Maybe Macro))) (do ..monad [[module name] (..normal full_name)] @@ -194,7 +195,7 @@ #.None (#try.Success [_ this_module]) - (find_macro' (get@ #.modules compiler) this_module module name))] + (macro' (get@ #.modules compiler) this_module module name))] (#try.Success [compiler macro])))))) (def: #export count @@ -220,7 +221,7 @@ #.None (f x2) (#.Some y) (#.Some y))) -(def: (find_type_var idx bindings) +(def: (type_variable idx bindings) (-> Nat (List [Nat (Maybe Type)]) (Maybe Type)) (case bindings #.Nil @@ -229,7 +230,7 @@ (#.Cons [var bound] bindings') (if (n.= idx var) bound - (find_type_var idx bindings')))) + (type_variable idx bindings')))) (def: (clean_type type) (-> Type (Meta Type)) @@ -238,7 +239,7 @@ (function (_ compiler) (case (|> compiler (get@ [#.type_context #.var_bindings]) - (find_type_var var)) + (type_variable var)) (^or #.None (#.Some (#.Var _))) (#try.Success [compiler type]) @@ -246,9 +247,9 @@ (#try.Success [compiler type']))) _ - (\ ..monad wrap type))) + (\ ..monad in type))) -(def: #export (find_var_type name) +(def: #export (var_type name) {#.doc "Looks-up the type of a local variable somewhere in the environment."} (-> Text (Meta Type)) (function (_ compiler) @@ -266,14 +267,14 @@ (get@ [#.locals #.mappings] scope)) (: (List [Text [Type Any]]) (get@ [#.captured #.mappings] scope)))] - (wrap type)) + (in type)) (#.Some var_type) ((clean_type var_type) compiler) #.None (#try.Failure ($_ text\compose "Unknown variable: " name)))))) -(def: #export (find_def name) +(def: #export (definition name) {#.doc "Looks-up a definition's whole data in the available modules (including the current one)."} (-> Name (Meta Global)) (do ..monad @@ -330,11 +331,11 @@ "") " All known modules: " (|> compiler (get@ #.modules) (list\map product.left) (text.join_with separator)) text.new_line))))))) -(def: #export (find_export name) +(def: #export (export name) {#.doc "Looks-up a definition's type in the available modules (including the current one)."} (-> Name (Meta Definition)) (do ..monad - [definition (..find_def name)] + [definition (..definition name)] (case definition (#.Left de_aliased) (failure ($_ text\compose @@ -344,42 +345,42 @@ (#.Right definition) (let [[exported? def_type def_data def_value] definition] (if exported? - (wrap definition) + (in definition) (failure ($_ text\compose "Definition is not an export: " (name\encode name)))))))) -(def: #export (find_def_type name) +(def: #export (definition_type name) {#.doc "Looks-up a definition's type in the available modules (including the current one)."} (-> Name (Meta Type)) (do ..monad - [definition (find_def name)] + [definition (definition name)] (case definition (#.Left de_aliased) - (find_def_type de_aliased) + (definition_type de_aliased) (#.Right [exported? def_type def_data def_value]) (clean_type def_type)))) -(def: #export (find_type name) +(def: #export (type name) {#.doc "Looks-up the type of either a local variable or a definition."} (-> Name (Meta Type)) (do ..monad [#let [[_ _name] name]] (case name ["" _name] - (either (find_var_type _name) - (find_def_type name)) + (either (var_type _name) + (definition_type name)) _ - (find_def_type name)))) + (definition_type name)))) -(def: #export (find_type_def name) +(def: #export (type_definition name) {#.doc "Finds the value of a type definition (such as Int, Any or Lux)."} (-> Name (Meta Type)) (do ..monad - [definition (find_def name)] + [definition (definition name)] (case definition (#.Left de_aliased) - (find_type_def de_aliased) + (type_definition de_aliased) (#.Right [exported? def_type def_data def_value]) (let [type_to_code (`` ("lux in-module" (~~ (static .prelude_module)) .type_to_code))] @@ -387,7 +388,7 @@ (\ code.equivalence = (type_to_code .Type) (type_to_code def_type))) - (wrap (:as Type def_value)) + (in (:as Type def_value)) (..failure ($_ text\compose "Definition is not a type: " (name\encode name)))))))) (def: #export (globals module) @@ -419,11 +420,11 @@ (-> Text (Meta (List [Text Definition]))) (do ..monad [constants (..definitions module_name)] - (wrap (do list.monad - [[name [exported? def_type def_data def_value]] constants] - (if exported? - (wrap [name [exported? def_type def_data def_value]]) - (list)))))) + (in (do list.monad + [[name [exported? def_type def_data def_value]] constants] + (if exported? + (in [name [exported? def_type def_data def_value]]) + (list)))))) (def: #export modules {#.doc "All the available modules (including the current one)."} @@ -439,13 +440,13 @@ (-> Name (Meta (Maybe (List Name)))) (do ..monad [#let [[module name] type_name] - module (find_module module)] + module (..module module)] (case (plist.get name (get@ #.types module)) (#.Some [tags _]) - (wrap (#.Some tags)) + (in (#.Some tags)) _ - (wrap #.None)))) + (in #.None)))) (def: #export location {#.doc "The location of the current expression being analyzed."} @@ -468,14 +469,14 @@ {#.doc "All the modules imported by a specified module."} (-> Text (Meta (List Text))) (do ..monad - [(^slots [#.imports]) (..find_module module_name)] - (wrap imports))) + [(^slots [#.imports]) (..module module_name)] + (in imports))) (def: #export (imported_by? import module) (-> Text Text (Meta Bit)) (do ..monad - [(^slots [#.imports]) (..find_module module)] - (wrap (list.any? (text\= import) imports)))) + [(^slots [#.imports]) (..module module)] + (in (list.any? (text\= import) imports)))) (def: #export (imported? import) (-> Text (Meta Bit)) @@ -488,14 +489,14 @@ (-> Name (Meta [Nat (List Name) Type])) (do ..monad [#let [[module name] tag] - =module (..find_module module) + =module (..module module) this_module_name ..current_module_name imported! (..imported? module)] (case (plist.get name (get@ #.tags =module)) (#.Some [idx tag_list exported? type]) (if (or (text\= this_module_name module) (and imported! exported?)) - (wrap [idx tag_list type]) + (in [idx tag_list type]) (..failure ($_ text\compose "Cannot access tag: " (name\encode tag) " from module " this_module_name))) _ @@ -511,14 +512,14 @@ {#.doc "All the tag-lists defined in a module, with their associated types."} (-> Text (Meta (List [(List Name) Type]))) (do ..monad - [=module (..find_module module) + [=module (..module module) this_module_name ..current_module_name] - (wrap (|> (get@ #.types =module) - (list.only (function (_ [type_name [tag_list exported? type]]) - (or exported? - (text\= this_module_name module)))) - (list\map (function (_ [type_name [tag_list exported? type]]) - [tag_list type])))))) + (in (|> (get@ #.types =module) + (list.only (function (_ [type_name [tag_list exported? type]]) + (or exported? + (text\= this_module_name module)))) + (list\map (function (_ [type_name [tag_list exported? type]]) + [tag_list type])))))) (def: #export locals {#.doc "All the local variables currently in scope, separated in different scopes."} @@ -539,13 +540,13 @@ {#.doc "Given an aliased definition's name, returns the original definition being referenced."} (-> Name (Meta Name)) (do ..monad - [constant (..find_def def_name)] - (wrap (case constant - (#.Left real_def_name) - real_def_name + [constant (..definition def_name)] + (in (case constant + (#.Left real_def_name) + real_def_name - (#.Right _) - def_name)))) + (#.Right _) + def_name)))) (def: #export get_compiler {#.doc "Obtains the current state of the compiler."} @@ -562,7 +563,7 @@ (All [a] (-> (Try a) (Meta a))) (case result (#try.Success output) - (\ ..monad wrap output) + (\ ..monad in output) (#try.Failure error) (..failure error))) diff --git a/stdlib/source/library/lux/program.lux b/stdlib/source/library/lux/program.lux index 51c22c701..f17d42ec1 100644 --- a/stdlib/source/library/lux/program.lux +++ b/stdlib/source/library/lux/program.lux @@ -28,7 +28,7 @@ (<>.or <code>.local_identifier (<code>.tuple (<>.some (<>.either (do <>.monad [name <code>.local_identifier] - (wrap [(code.identifier ["" name]) (` (~! <cli>.any))])) + (in [(code.identifier ["" name]) (` (~! <cli>.any))])) (<code>.record (<>.and <code>.any <code>.any))))))) (syntax: #export (program: @@ -41,7 +41,7 @@ (do io.monad [foo init_program bar (do_something all_args)] - (wrap []))) + (in []))) (program: [name] (io (log! (\ text.monoid compose "Hello, " name)))) @@ -59,26 +59,26 @@ @.js (list) @.python (list)} (list g!_ (` (~! thread.run!)))))] - ((~' wrap) (~ g!output))))] - (wrap (list (` ("lux def program" - (~ (case args - (#Raw args) - (` (.function ((~ g!program) (~ (code.identifier ["" args]))) - (~ initialization+event_loop))) - - (#Parsed args) - (` (.function ((~ g!program) (~ g!args)) - (case ((~! <cli>.run) (: (~! (<cli>.Parser (io.IO .Any))) - ((~! do) (~! <>.monad) - [(~+ (|> args - (list\map (function (_ [binding parser]) - (list binding parser))) - list\join)) - (~ g!_) (~! <cli>.end)] - ((~' wrap) (~ initialization+event_loop)))) - (~ g!args)) - (#.Right (~ g!output)) - (~ g!output) + ((~' in) (~ g!output))))] + (in (list (` ("lux def program" + (~ (case args + (#Raw args) + (` (.function ((~ g!program) (~ (code.identifier ["" args]))) + (~ initialization+event_loop))) + + (#Parsed args) + (` (.function ((~ g!program) (~ g!args)) + (case ((~! <cli>.run) (: (~! (<cli>.Parser (io.IO .Any))) + ((~! do) (~! <>.monad) + [(~+ (|> args + (list\map (function (_ [binding parser]) + (list binding parser))) + list\join)) + (~ g!_) (~! <cli>.end)] + ((~' in) (~ initialization+event_loop)))) + (~ g!args)) + (#.Right (~ g!output)) + (~ g!output) - (#.Left (~ g!message)) - (.error! (~ g!message)))))))))))))) + (#.Left (~ g!message)) + (.error! (~ g!message)))))))))))))) diff --git a/stdlib/source/library/lux/target/common_lisp.lux b/stdlib/source/library/lux/target/common_lisp.lux index a83162d28..9fb5dfaa3 100644 --- a/stdlib/source/library/lux/target/common_lisp.lux +++ b/stdlib/source/library/lux/target/common_lisp.lux @@ -192,7 +192,7 @@ definitions)) body))) - (def: #export (destructuring-bind [bindings expression] body) + (def: #export (destructuring_bind [bindings expression] body) (-> [Var/* (Expression Any)] (List (Expression Any)) (Computation Any)) (..form (list& (..var "destructuring-bind") (:transmutation bindings) expression @@ -211,32 +211,32 @@ (~~ (template.spliced <function>+))))] [call/0 [] [] - [[get-universal-time/0 "get-universal-time"] - [make-hash-table/0 "make-hash-table"]]] + [[get_universal_time/0 "get-universal-time"] + [make_hash_table/0 "make-hash-table"]]] [call/1 [in0] [(Expression Any)] [[length/1 "length"] [function/1 "function"] - [copy-seq/1 "copy-seq"] + [copy_seq/1 "copy-seq"] [null/1 "null"] [error/1 "error"] [not/1 "not"] [floor/1 "floor"] - [type-of/1 "type-of"] - [write-to-string/1 "write-to-string"] - [read-from-string/1 "read-from-string"] + [type_of/1 "type-of"] + [write_to_string/1 "write-to-string"] + [read_from_string/1 "read-from-string"] [print/1 "print"] [reverse/1 "reverse"] [sxhash/1 "sxhash"] - [string-upcase/1 "string-upcase"] - [string-downcase/1 "string-downcase"] - [char-int/1 "char-int"] + [string_upcase/1 "string-upcase"] + [string_downcase/1 "string-downcase"] + [char_int/1 "char-int"] [text/1 "text"] - [hash-table-size/1 "hash-table-size"] - [hash-table-rehash-size/1 "hash-table-rehash-size"] - [code-char/1 "code-char"] - [char-code/1 "char-code"] + [hash_table_size/1 "hash-table-size"] + [hash_table_rehash_size/1 "hash-table-rehash-size"] + [code_char/1 "code-char"] + [char_code/1 "char-code"] [string/1 "string"] - [write-line/1 "write-line"] + [write_line/1 "write-line"] [pprint/1 "pprint"] [identity/1 "identity"]]] [call/2 [in0 in1] [(Expression Any) (Expression Any)] @@ -279,7 +279,7 @@ [gethash/2 "gethash"]]] ) - (def: #export (make-hash-table/with_size size) + (def: #export (make_hash_table/with_size size) (-> (Expression Any) (Computation Any)) (..call/* (..var "make-hash-table") (list (..keyword "size") @@ -387,7 +387,7 @@ #condition Var/1 #body (Expression Any)}) - (def: #export (handler-case handlers body) + (def: #export (handler_case handlers body) (-> (List Handler) (Expression Any) (Computation Any)) (..form (list& (..var "handler-case") body @@ -426,7 +426,7 @@ (-> Label (List (Expression Any)) (Computation Any)) (..form (list& (..var "block") (:transmutation name) body))) - (def: #export (return-from target value) + (def: #export (return_from target value) (-> Label (Expression Any) (Computation Any)) (..form (list (..var "return-from") (:transmutation target) value))) @@ -451,12 +451,12 @@ (|>> (list (..var "go")) ..form)) - (def: #export values-list/1 + (def: #export values_list/1 (-> (Expression Any) (Expression Any)) (|>> (list (..var "values-list")) ..form)) - (def: #export (multiple-value-setq bindings values) + (def: #export (multiple_value_setq bindings values) (-> Var/* (Expression Any) (Expression Any)) (..form (list (..var "multiple-value-setq") (:transmutation bindings) diff --git a/stdlib/source/library/lux/target/jvm/attribute.lux b/stdlib/source/library/lux/target/jvm/attribute.lux index d7d3cd36c..6d94c1b5b 100644 --- a/stdlib/source/library/lux/target/jvm/attribute.lux +++ b/stdlib/source/library/lux/target/jvm/attribute.lux @@ -94,7 +94,7 @@ (-> (Constant Any) (Resource Attribute)) (do //constant/pool.monad [@name (//constant/pool.utf8 "ConstantValue")] - (wrap (constant' @name index)))) + (in (constant' @name index)))) ## TODO: Inline ASAP (def: (code' @name specification) @@ -111,7 +111,7 @@ (-> Code (Resource Attribute)) (do //constant/pool.monad [@name (//constant/pool.utf8 "Code")] - (wrap (code' @name specification)))) + (in (code' @name specification)))) (def: #export (writer value) (Writer Attribute) diff --git a/stdlib/source/library/lux/target/jvm/bytecode.lux b/stdlib/source/library/lux/target/jvm/bytecode.lux index ba09af5bb..8571aeece 100644 --- a/stdlib/source/library/lux/target/jvm/bytecode.lux +++ b/stdlib/source/library/lux/target/jvm/bytecode.lux @@ -94,8 +94,8 @@ (do try.monad [[left_exceptions left_instruction] (left resolver) [right_exceptions right_instruction] (right resolver)] - (wrap [(\ row.monoid compose left_exceptions right_exceptions) - (_\compose left_instruction right_instruction)])))))) + (in [(\ row.monoid compose left_exceptions right_exceptions) + (_\compose left_instruction right_instruction)])))))) (type: #export (Bytecode a) (State' Try [Pool Environment Tracker] (Writer Relative a))) @@ -125,20 +125,20 @@ ["Expected" (/stack.format expected)] ["Actual" (/stack.format actual)])) -(with_expansions [<success> (as_is (wrap [[pool - environment - (update@ #known - (dictionary.put label [actual (#.Some @here)]) - tracker)] - [..relative_identity - []]]))] +(with_expansions [<success> (as_is (in [[pool + environment + (update@ #known + (dictionary.put label [actual (#.Some @here)]) + tracker)] + [..relative_identity + []]]))] (def: #export (set_label label) (-> Label (Bytecode Any)) (function (_ [pool environment tracker]) (let [@here (get@ #program_counter tracker)] (case (dictionary.get label (get@ #known tracker)) (#.Some [expected (#.Some address)]) - (exception.throw ..label_has_already_been_set [label]) + (exception.except ..label_has_already_been_set [label]) (#.Some [expected #.None]) (do try.monad @@ -166,7 +166,7 @@ (-> Text Bytecode) (|>> #try.Failure function.constant)) -(def: #export (throw exception value) +(def: #export (except exception value) (All [e] (-> (exception.Exception e) e Bytecode)) (..failure (exception.construct exception value))) @@ -176,7 +176,7 @@ (do try.monad [[[pool environment tracker] [relative output]] (bytecode [pool environment ..fresh]) [exceptions instruction] (relative (get@ #known tracker))] - (wrap [pool [environment exceptions instruction output]])))) + (in [pool [environment exceptions instruction output]])))) (def: (step estimator counter) (-> Estimator Address (Try Address)) @@ -191,11 +191,11 @@ (monad.bind ! (/environment.produces production)) (monad.bind ! (/environment.has registry))) program_counter' (step estimator (get@ #program_counter tracker))] - (wrap [[pool - environment' - (set@ #program_counter program_counter' tracker)] - [(function.constant (wrap [..no_exceptions (bytecode input)])) - []]])))) + (in [[pool + environment' + (set@ #program_counter program_counter' tracker)] + [(function.constant (in [..no_exceptions (bytecode input)])) + []]])))) (template [<name> <frames>] [(def: <name> U2 (|> <frames> //unsigned.u2 try.assumed))] @@ -409,11 +409,11 @@ (function (_ [pool environment tracker]) (do try.monad [_ (/environment.stack environment)] - (wrap [[pool - (/environment.discontinue environment) - tracker] - [..relative_identity - []]])))) + (in [[pool + (/environment.discontinue environment) + tracker] + [..relative_identity + []]])))) (template [<name> <consumption> <instruction>] [(def: #export <name> @@ -443,9 +443,9 @@ (function (_ [pool environment tracker]) (do try.monad [[pool' output] (resource pool)] - (wrap [[pool' environment tracker] - [..relative_identity - output]])))) + (in [[pool' environment tracker] + [..relative_identity + output]])))) (def: #export (string value) (-> //constant.UTF8 (Bytecode Any)) @@ -581,10 +581,10 @@ (-> Nat (Bytecode Register)) (case (//unsigned.u1 id) (#try.Success register) - (\ ..monad wrap register) + (\ ..monad in register) (#try.Failure error) - (..throw ..invalid_register [id]))) + (..except ..invalid_register [id]))) (template [<for> <size> <name> <general> <specials>] [(def: #export (<name> local) @@ -714,10 +714,10 @@ (#try.Success [actual address]) (#.Some [actual #.None]) - (exception.throw ..unset_label [label]) + (exception.except ..unset_label [label]) #.None - (exception.throw ..unknown_label [label]))) + (exception.except ..unknown_label [label]))) (def: (acknowledge_label stack label tracker) (-> Stack Label Tracker Tracker) @@ -739,25 +739,25 @@ (/environment.consumes <consumption>)) actual (/environment.stack environment') program_counter' (step estimator @here)] - (wrap (let [@from @here] - [[pool - environment' - (|> tracker - (..acknowledge_label actual label) - (set@ #program_counter program_counter'))] - [(function (_ resolver) - (do try.monad - [[expected @to] (..resolve_label label resolver) - _ (exception.assert ..mismatched_environments [(name_of <instruction>) label @here expected actual] - (\ /stack.equivalence = expected actual)) - jump (..jump @from @to)] - (case jump - (#.Left jump) - (exception.throw ..cannot_do_a_big_jump [label @from jump]) - - (#.Right jump) - (wrap [..no_exceptions (bytecode jump)])))) - []]])))))))] + (in (let [@from @here] + [[pool + environment' + (|> tracker + (..acknowledge_label actual label) + (set@ #program_counter program_counter'))] + [(function (_ resolver) + (do try.monad + [[expected @to] (..resolve_label label resolver) + _ (exception.assert ..mismatched_environments [(name_of <instruction>) label @here expected actual] + (\ /stack.equivalence = expected actual)) + jump (..jump @from @to)] + (case jump + (#.Left jump) + (exception.except ..cannot_do_a_big_jump [label @from jump]) + + (#.Right jump) + (in [..no_exceptions (bytecode jump)])))) + []]])))))))] [$1 ifeq _.ifeq] [$1 ifne _.ifne] @@ -789,39 +789,39 @@ [actual (/environment.stack environment) #let [@here (get@ #program_counter tracker)] program_counter' (step estimator @here)] - (wrap (let [@from @here] - [[pool - (/environment.discontinue environment) - (|> tracker - (..acknowledge_label actual label) - (set@ #program_counter program_counter'))] - [(function (_ resolver) - (case (dictionary.get label resolver) - (#.Some [expected (#.Some @to)]) - (do try.monad - [_ (exception.assert ..mismatched_environments [(name_of <instruction>) label @here expected actual] - (\ /stack.equivalence = expected actual)) - jump (..jump @from @to)] - (case jump - (#.Left jump) - <on_long_jump> - - (#.Right jump) - <on_short_jump>)) - - (#.Some [expected #.None]) - (exception.throw ..unset_label [label]) - - #.None - (exception.throw ..unknown_label [label]))) - []]]))))))] + (in (let [@from @here] + [[pool + (/environment.discontinue environment) + (|> tracker + (..acknowledge_label actual label) + (set@ #program_counter program_counter'))] + [(function (_ resolver) + (case (dictionary.get label resolver) + (#.Some [expected (#.Some @to)]) + (do try.monad + [_ (exception.assert ..mismatched_environments [(name_of <instruction>) label @here expected actual] + (\ /stack.equivalence = expected actual)) + jump (..jump @from @to)] + (case jump + (#.Left jump) + <on_long_jump> + + (#.Right jump) + <on_short_jump>)) + + (#.Some [expected #.None]) + (exception.except ..unset_label [label]) + + #.None + (exception.except ..unknown_label [label]))) + []]]))))))] [goto _.goto - (exception.throw ..cannot_do_a_big_jump [label @from jump]) - (wrap [..no_exceptions (bytecode jump)])] + (exception.except ..cannot_do_a_big_jump [label @from jump]) + (in [..no_exceptions (bytecode jump)])] [goto_w _.goto_w - (wrap [..no_exceptions (bytecode jump)]) - (wrap [..no_exceptions (bytecode (/jump.lift jump))])] + (in [..no_exceptions (bytecode jump)]) + (in [..no_exceptions (bytecode (/jump.lift jump))])] ) (def: (big_jump jump) @@ -844,33 +844,33 @@ (/environment.consumes $1)) actual (/environment.stack environment') program_counter' (step (estimator (list.size afterwards)) (get@ #program_counter tracker))] - (wrap (let [@from (get@ #program_counter tracker)] - [[pool - environment' - (|> (list\fold (..acknowledge_label actual) tracker (list& default at_minimum afterwards)) - (set@ #program_counter program_counter'))] - [(function (_ resolver) - (let [get (: (-> Label (Maybe [Stack (Maybe Address)])) - (function (_ label) - (dictionary.get label resolver)))] - (case (do {! maybe.monad} - [@default (|> default get (monad.bind ! product.right)) - @at_minimum (|> at_minimum get (monad.bind ! product.right)) - @afterwards (|> afterwards - (monad.map ! get) - (monad.bind ! (monad.map ! product.right)))] - (wrap [@default @at_minimum @afterwards])) - (#.Some [@default @at_minimum @afterwards]) - (do {! try.monad} - [>default (\ ! map ..big_jump (..jump @from @default)) - >at_minimum (\ ! map ..big_jump (..jump @from @at_minimum)) - >afterwards (monad.map ! (|>> (..jump @from) (\ ! map ..big_jump)) - @afterwards)] - (wrap [..no_exceptions (bytecode minimum >default [>at_minimum >afterwards])])) - - #.None - (exception.throw ..invalid_tableswitch [])))) - []]])))))) + (in (let [@from (get@ #program_counter tracker)] + [[pool + environment' + (|> (list\fold (..acknowledge_label actual) tracker (list& default at_minimum afterwards)) + (set@ #program_counter program_counter'))] + [(function (_ resolver) + (let [get (: (-> Label (Maybe [Stack (Maybe Address)])) + (function (_ label) + (dictionary.get label resolver)))] + (case (do {! maybe.monad} + [@default (|> default get (monad.bind ! product.right)) + @at_minimum (|> at_minimum get (monad.bind ! product.right)) + @afterwards (|> afterwards + (monad.map ! get) + (monad.bind ! (monad.map ! product.right)))] + (in [@default @at_minimum @afterwards])) + (#.Some [@default @at_minimum @afterwards]) + (do {! try.monad} + [>default (\ ! map ..big_jump (..jump @from @default)) + >at_minimum (\ ! map ..big_jump (..jump @from @at_minimum)) + >afterwards (monad.map ! (|>> (..jump @from) (\ ! map ..big_jump)) + @afterwards)] + (in [..no_exceptions (bytecode minimum >default [>at_minimum >afterwards])])) + + #.None + (exception.except ..invalid_tableswitch [])))) + []]])))))) (exception: #export invalid_lookupswitch) @@ -887,32 +887,32 @@ (/environment.consumes $1)) actual (/environment.stack environment') program_counter' (step (estimator (list.size cases)) (get@ #program_counter tracker))] - (wrap (let [@from (get@ #program_counter tracker)] - [[pool - environment' - (|> (list\fold (..acknowledge_label actual) tracker (list& default (list\map product.right cases))) - (set@ #program_counter program_counter'))] - [(function (_ resolver) - (let [get (: (-> Label (Maybe [Stack (Maybe Address)])) - (function (_ label) - (dictionary.get label resolver)))] - (case (do {! maybe.monad} - [@default (|> default get (monad.bind ! product.right)) - @cases (|> cases - (monad.map ! (|>> product.right get)) - (monad.bind ! (monad.map ! product.right)))] - (wrap [@default @cases])) - (#.Some [@default @cases]) - (do {! try.monad} - [>default (\ ! map ..big_jump (..jump @from @default)) - >cases (|> @cases - (monad.map ! (|>> (..jump @from) (\ ! map ..big_jump))) - (\ ! map (|>> (list.zipped/2 (list\map product.left cases)))))] - (wrap [..no_exceptions (bytecode >default >cases)])) - - #.None - (exception.throw ..invalid_lookupswitch [])))) - []]])))))) + (in (let [@from (get@ #program_counter tracker)] + [[pool + environment' + (|> (list\fold (..acknowledge_label actual) tracker (list& default (list\map product.right cases))) + (set@ #program_counter program_counter'))] + [(function (_ resolver) + (let [get (: (-> Label (Maybe [Stack (Maybe Address)])) + (function (_ label) + (dictionary.get label resolver)))] + (case (do {! maybe.monad} + [@default (|> default get (monad.bind ! product.right)) + @cases (|> cases + (monad.map ! (|>> product.right get)) + (monad.bind ! (monad.map ! product.right)))] + (in [@default @cases])) + (#.Some [@default @cases]) + (do {! try.monad} + [>default (\ ! map ..big_jump (..jump @from @default)) + >cases (|> @cases + (monad.map ! (|>> (..jump @from) (\ ! map ..big_jump))) + (\ ! map (|>> (list.zipped/2 (list\map product.left cases)))))] + (in [..no_exceptions (bytecode >default >cases)])) + + #.None + (exception.except ..invalid_lookupswitch [])))) + []]])))))) (def: reflection (All [category] @@ -947,8 +947,8 @@ (do ..monad [_ (: (Bytecode Any) (case (|> dimensions //unsigned.value) - 0 (..throw ..multiarray_cannot_be_zero_dimensional [class]) - _ (wrap []))) + 0 (..except ..multiarray_cannot_be_zero_dimensional [class]) + _ (in []))) index (..lift (//constant/pool.class (//name.internal (..reflection class))))] (..bytecode (//unsigned.lift/2 dimensions) $1 @_ _.multianewarray [index dimensions]))) @@ -1028,14 +1028,14 @@ [[_ @start] (..resolve_label @start resolver) [_ @end] (..resolve_label @end resolver) _ (if (/address.after? @start @end) - (wrap []) - (exception.throw ..invalid_range_for_try [@start @end])) + (in []) + (exception.except ..invalid_range_for_try [@start @end])) [_ @handler] (..resolve_label @handler resolver)] - (wrap [(row.row {#//exception.start @start - #//exception.end @end - #//exception.handler @handler - #//exception.catch @catch}) - _.empty]))) + (in [(row.row {#//exception.start @start + #//exception.end @end + #//exception.handler @handler + #//exception.catch @catch}) + _.empty]))) []]])))) (def: #export (compose pre post) diff --git a/stdlib/source/library/lux/target/jvm/bytecode/environment.lux b/stdlib/source/library/lux/target/jvm/bytecode/environment.lux index fdf50d974..289e3bd99 100644 --- a/stdlib/source/library/lux/target/jvm/bytecode/environment.lux +++ b/stdlib/source/library/lux/target/jvm/bytecode/environment.lux @@ -26,8 +26,8 @@ (-> (Type Method) (Try Environment)) (do try.monad [limit (<limit> type)] - (wrap {#limit limit - #stack (#.Some /stack.empty)})))] + (in {#limit limit + #stack (#.Some /stack.empty)})))] [static /limit.static] [virtual /limit.virtual] @@ -56,7 +56,7 @@ (#try.Success stack) #.None - (exception.throw ..discontinuity []))) + (exception.except ..discontinuity []))) (def: #export discontinue (-> Environment Environment) @@ -74,7 +74,7 @@ (#.Some actual) (if (\ /stack.equivalence = expected actual) (#try.Success [actual environment]) - (exception.throw ..mismatched_stacks [expected actual])) + (exception.except ..mismatched_stacks [expected actual])) #.None (#try.Success [expected (set@ #..stack (#.Some expected) environment)]))) @@ -87,7 +87,7 @@ (do try.monad [previous (..stack environment) current (/stack.pop amount previous)] - (wrap (set@ #..stack (#.Some current) environment))))) + (in (set@ #..stack (#.Some current) environment))))) (def: #export (produces amount) (-> U2 Condition) @@ -98,9 +98,9 @@ #let [limit (|> environment (get@ [#..limit #/limit.stack]) (/stack.max current))]] - (wrap (|> environment - (set@ #..stack (#.Some current)) - (set@ [#..limit #/limit.stack] limit)))))) + (in (|> environment + (set@ #..stack (#.Some current)) + (set@ [#..limit #/limit.stack] limit)))))) (def: #export (has registry) (-> Registry Condition) diff --git a/stdlib/source/library/lux/target/jvm/bytecode/environment/limit.lux b/stdlib/source/library/lux/target/jvm/bytecode/environment/limit.lux index c7e9a8959..fad7c9dae 100644 --- a/stdlib/source/library/lux/target/jvm/bytecode/environment/limit.lux +++ b/stdlib/source/library/lux/target/jvm/bytecode/environment/limit.lux @@ -29,8 +29,8 @@ (-> (Type Method) (Try Limit)) (do try.monad [registry (<registry> type)] - (wrap {#stack /stack.empty - #registry registry})))] + (in {#stack /stack.empty + #registry registry})))] [static /registry.static] [virtual /registry.virtual] diff --git a/stdlib/source/library/lux/target/jvm/bytecode/instruction.lux b/stdlib/source/library/lux/target/jvm/bytecode/instruction.lux index d4f4ba688..a77eb88a4 100644 --- a/stdlib/source/library/lux/target/jvm/bytecode/instruction.lux +++ b/stdlib/source/library/lux/target/jvm/bytecode/instruction.lux @@ -623,7 +623,7 @@ (binary.write/16 (inc offset) 0 binary)) 2 (binary.write/16 offset 0 binary) 1 (binary.write/8 offset 0 binary) - _ (wrap binary)) + _ (in binary)) #let [offset (n.+ padding offset)] _ (binary.write/32 offset (///signed.value default) binary) #let [offset (n.+ (///unsigned.value ..big_jump_size) offset)] @@ -635,7 +635,7 @@ (#.Cons at_minimum afterwards))] (case afterwards #.Nil - (wrap binary) + (in binary) (#.Cons head tail) (do ! @@ -685,7 +685,7 @@ (binary.write/16 (inc offset) 0 binary)) 2 (binary.write/16 offset 0 binary) 1 (binary.write/8 offset 0 binary) - _ (wrap binary)) + _ (in binary)) #let [offset (n.+ padding offset)] _ (binary.write/32 offset (///signed.value default) binary) #let [offset (n.+ (///unsigned.value ..big_jump_size) offset)] @@ -694,7 +694,7 @@ cases cases] (case cases #.Nil - (wrap binary) + (in binary) (#.Cons [value jump] tail) (do ! diff --git a/stdlib/source/library/lux/target/jvm/class.lux b/stdlib/source/library/lux/target/jvm/class.lux index 165f9a33f..2e4b8eb15 100644 --- a/stdlib/source/library/lux/target/jvm/class.lux +++ b/stdlib/source/library/lux/target/jvm/class.lux @@ -1,18 +1,18 @@ - (.module: - [library - [lux #* - [abstract - [equivalence (#+ Equivalence)] - ["." monad (#+ do)]] - [control - ["." state] - ["." try (#+ Try)]] - [data - ["." product] - [format - [".F" binary (#+ Writer) ("#\." monoid)]] - [collection - ["." row (#+ Row)]]]]] +(.module: + [library + [lux #* + [abstract + [equivalence (#+ Equivalence)] + ["." monad (#+ do)]] + [control + ["." state] + ["." try (#+ Try)]] + [data + ["." product] + [format + [".F" binary (#+ Writer) ("#\." monoid)]] + [collection + ["." row (#+ Row)]]]]] ["." // #_ ["#." modifier (#+ Modifier modifiers:)] ["#." version (#+ Version Minor Major)] @@ -76,10 +76,10 @@ (monad.fold ! (function (_ interface @interfaces) (do ! [@interface (//constant/pool.class interface)] - (wrap (row.add @interface @interfaces)))) + (in (row.add @interface @interfaces)))) row.empty interfaces))] - (wrap [@this @super @interfaces]))) + (in [@this @super @interfaces]))) (def: #export (class version modifier this super interfaces @@ -97,18 +97,18 @@ [classes (install_classes this super interfaces) =fields (monad.seq //constant/pool.monad fields) =methods (monad.seq //constant/pool.monad methods)] - (wrap [classes =fields =methods])))] - (wrap {#magic //magic.code - #minor_version //version.default_minor - #major_version version - #constant_pool pool - #modifier modifier - #this @this - #super @super - #interfaces @interfaces - #fields (row.of_list =fields) - #methods (row.of_list =methods) - #attributes attributes}))) + (in [classes =fields =methods])))] + (in {#magic //magic.code + #minor_version //version.default_minor + #major_version version + #constant_pool pool + #modifier modifier + #this @this + #super @super + #interfaces @interfaces + #fields (row.of_list =fields) + #methods (row.of_list =methods) + #attributes attributes}))) (def: #export (writer class) (Writer Class) diff --git a/stdlib/source/library/lux/target/jvm/constant/pool.lux b/stdlib/source/library/lux/target/jvm/constant/pool.lux index b4697768a..18b6a9c61 100644 --- a/stdlib/source/library/lux/target/jvm/constant/pool.lux +++ b/stdlib/source/library/lux/target/jvm/constant/pool.lux @@ -76,9 +76,9 @@ //index.value (//unsigned.+/2 @new) (\ ! map //index.index)))] - (wrap [[next - (row.add [current new] pool)] - current]))))))))) + (in [[next + (row.add [current new] pool)] + current]))))))))) (template: (!index <index>) (|> <index> //index.value //unsigned.value)) diff --git a/stdlib/source/library/lux/target/jvm/encoding/signed.lux b/stdlib/source/library/lux/target/jvm/encoding/signed.lux index a914dfc3c..1958ea63c 100644 --- a/stdlib/source/library/lux/target/jvm/encoding/signed.lux +++ b/stdlib/source/library/lux/target/jvm/encoding/signed.lux @@ -68,7 +68,7 @@ (i64.and positive value)) value) (#try.Success (:abstraction value)) - (exception.throw ..value_exceeds_the_scope [value <size>]))))) + (exception.except ..value_exceeds_the_scope [value <size>]))))) (template [<abstract_operation> <concrete_operation>] [(def: #export (<abstract_operation> parameter subject) diff --git a/stdlib/source/library/lux/target/jvm/encoding/unsigned.lux b/stdlib/source/library/lux/target/jvm/encoding/unsigned.lux index d8299fa65..546d4f516 100644 --- a/stdlib/source/library/lux/target/jvm/encoding/unsigned.lux +++ b/stdlib/source/library/lux/target/jvm/encoding/unsigned.lux @@ -74,7 +74,7 @@ (-> Nat (Try <name>)) (if (n.<= (:representation <maximum>) value) (#try.Success (:abstraction value)) - (exception.throw ..value_exceeds_the_maximum [(name_of <name>) value <maximum>]))) + (exception.except ..value_exceeds_the_maximum [(name_of <name>) value <maximum>]))) (def: #export (<+> parameter subject) (-> <name> <name> (Try <name>)) @@ -88,7 +88,7 @@ subject' (:representation subject)] (if (n.<= subject' parameter') (#try.Success (:abstraction (n.- parameter' subject'))) - (exception.throw ..subtraction_cannot_yield_negative_value [(name_of <name>) parameter subject])))) + (exception.except ..subtraction_cannot_yield_negative_value [(name_of <name>) parameter subject])))) (def: #export (<max> left right) (-> <name> <name> <name>) diff --git a/stdlib/source/library/lux/target/jvm/field.lux b/stdlib/source/library/lux/target/jvm/field.lux index aa71794a5..93cda4c5e 100644 --- a/stdlib/source/library/lux/target/jvm/field.lux +++ b/stdlib/source/library/lux/target/jvm/field.lux @@ -64,7 +64,7 @@ (do //constant/pool.monad [@name (//constant/pool.utf8 name) @descriptor (//constant/pool.descriptor (//type.descriptor type))] - (wrap {#modifier modifier - #name @name - #descriptor @descriptor - #attributes attributes}))) + (in {#modifier modifier + #name @name + #descriptor @descriptor + #attributes attributes}))) diff --git a/stdlib/source/library/lux/target/jvm/loader.lux b/stdlib/source/library/lux/target/jvm/loader.lux index 5cc5e9310..67d786da5 100644 --- a/stdlib/source/library/lux/target/jvm/loader.lux +++ b/stdlib/source/library/lux/target/jvm/loader.lux @@ -131,10 +131,10 @@ (do {! io.monad} [library' (atom.read library)] (if (dictionary.key? library' name) - (wrap (exception.throw ..already_stored name)) + (in (exception.except ..already_stored name)) (do ! [_ (atom.update (dictionary.put name bytecode) library)] - (wrap (#try.Success [])))))) + (in (#try.Success [])))))) (def: #export (load name loader) (-> Text java/lang/ClassLoader diff --git a/stdlib/source/library/lux/target/jvm/method.lux b/stdlib/source/library/lux/target/jvm/method.lux index 3dcc4d7a2..6df81d091 100644 --- a/stdlib/source/library/lux/target/jvm/method.lux +++ b/stdlib/source/library/lux/target/jvm/method.lux @@ -63,7 +63,7 @@ (//bytecode/environment.static type) (//bytecode/environment.virtual type)) (#try.Success environment) - (wrap environment) + (in environment) (#try.Failure error) (function (_ _) (#try.Failure error))) @@ -73,14 +73,14 @@ #//attribute/code.code bytecode #//attribute/code.exception_table exceptions #//attribute/code.attributes (row.row)})] - (wrap (row.add @code attributes))) + (in (row.add @code attributes))) #.None - (wrap attributes))] - (wrap {#modifier modifier - #name @name - #descriptor @descriptor - #attributes attributes}))) + (in attributes))] + (in {#modifier modifier + #name @name + #descriptor @descriptor + #attributes attributes}))) (def: #export equivalence (Equivalence Method) diff --git a/stdlib/source/library/lux/target/jvm/modifier.lux b/stdlib/source/library/lux/target/jvm/modifier.lux index 80db613de..d6fae89ed 100644 --- a/stdlib/source/library/lux/target/jvm/modifier.lux +++ b/stdlib/source/library/lux/target/jvm/modifier.lux @@ -80,9 +80,9 @@ (syntax: #export (modifiers: ofT {options (<>.many <c>.any)}) (with_gensyms [g!modifier g!code] - (wrap (list (` (template [(~ g!code) (~ g!modifier)] - [(def: (~' #export) (~ g!modifier) - (..Modifier (~ ofT)) - ((~! ..modifier) ((~! number.hex) (~ g!code))))] - - (~+ options))))))) + (in (list (` (template [(~ g!code) (~ g!modifier)] + [(def: (~' #export) (~ g!modifier) + (..Modifier (~ ofT)) + ((~! ..modifier) ((~! number.hex) (~ g!code))))] + + (~+ options))))))) diff --git a/stdlib/source/library/lux/target/jvm/reflection.lux b/stdlib/source/library/lux/target/jvm/reflection.lux index 5745ecd89..086a394bb 100644 --- a/stdlib/source/library/lux/target/jvm/reflection.lux +++ b/stdlib/source/library/lux/target/jvm/reflection.lux @@ -132,14 +132,14 @@ (#try.Success class) (#try.Failure _) - (exception.throw ..unknown_class name))) + (exception.except ..unknown_class name))) (def: #export (sub? class_loader super sub) (-> java/lang/ClassLoader External External (Try Bit)) (do try.monad [super (..load class_loader super) sub (..load class_loader sub)] - (wrap (java/lang/Class::isAssignableFrom sub super)))) + (in (java/lang/Class::isAssignableFrom sub super)))) (def: (class' parameter reflection) (-> (-> java/lang/reflect/Type (Try (/.Type Parameter))) @@ -163,7 +163,7 @@ [/reflection.double] [/reflection.char])) (text.starts_with? /descriptor.array_prefix class_name)) - (exception.throw ..not_a_class reflection) + (exception.except ..not_a_class reflection) (#try.Success (/.class class_name (list)))))) _) (case (ffi.check java/lang/reflect/ParameterizedType reflection) @@ -176,16 +176,16 @@ java/lang/reflect/ParameterizedType::getActualTypeArguments array.to_list (monad.map ! parameter))] - (wrap (/.class (|> raw - (:as (java/lang/Class java/lang/Object)) - java/lang/Class::getName) - paramsT))) + (in (/.class (|> raw + (:as (java/lang/Class java/lang/Object)) + java/lang/Class::getName) + paramsT))) _ - (exception.throw ..not_a_class raw))) + (exception.except ..not_a_class raw))) _) ## else - (exception.throw ..cannot_convert_to_a_lux_type reflection))) + (exception.except ..cannot_convert_to_a_lux_type reflection))) (def: #export (parameter reflection) (-> java/lang/reflect/Type (Try (/.Type Parameter))) @@ -309,22 +309,22 @@ (dictionary.put name paramT mapping)) /lux.fresh) #try.Success) - (exception.throw ..type_parameter_mismatch [num_class_params num_type_params class type])) - (exception.throw ..cannot_correspond [class type]))) + (exception.except ..type_parameter_mismatch [num_class_params num_type_params class type])) + (exception.except ..cannot_correspond [class type]))) (#.Named name anonymousT) (correspond class anonymousT) (#.Apply inputT abstractionT) - (case (type.apply (list inputT) abstractionT) + (case (type.applied (list inputT) abstractionT) (#.Some outputT) (correspond class outputT) #.None - (exception.throw ..non_jvm_type [type])) + (exception.except ..non_jvm_type [type])) _ - (exception.throw ..non_jvm_type [type]))) + (exception.except ..non_jvm_type [type]))) (exception: #export (mistaken_field_owner {field java/lang/reflect/Field} {owner (java/lang/Class java/lang/Object)} @@ -353,10 +353,10 @@ (let [owner (java/lang/reflect/Field::getDeclaringClass field)] (if (is? owner target) (#try.Success field) - (exception.throw ..mistaken_field_owner [field owner target]))) + (exception.except ..mistaken_field_owner [field owner target]))) (#try.Failure _) - (exception.throw ..unknown_field [field target]))) + (exception.except ..unknown_field [field target]))) (def: #export deprecated? (-> (array.Array java/lang/annotation/Annotation) Bit) @@ -377,7 +377,7 @@ ..type (\ ! map (|>> [(java/lang/reflect/Modifier::isFinal modifiers) (..deprecated? (java/lang/reflect/Field::getDeclaredAnnotations fieldJ))]))) - <else?> (exception.throw <exception> [field class]))))] + <else?> (exception.except <exception> [field class]))))] [static_field ..not_a_static_field #1 #0] [virtual_field ..not_a_virtual_field #0 #1] diff --git a/stdlib/source/library/lux/target/jvm/type/alias.lux b/stdlib/source/library/lux/target/jvm/type/alias.lux index 315dff281..e7cc570c1 100644 --- a/stdlib/source/library/lux/target/jvm/type/alias.lux +++ b/stdlib/source/library/lux/target/jvm/type/alias.lux @@ -35,10 +35,10 @@ (-> Aliasing (Parser (Type Var))) (do <>.monad [var //parser.var'] - (wrap (|> aliasing - (dictionary.get var) - (maybe.default var) - //.var)))) + (in (|> aliasing + (dictionary.get var) + (maybe.default var) + //.var)))) (def: (class parameter) (-> (Parser (Type Parameter)) (Parser (Type Class))) @@ -48,7 +48,7 @@ (<>.after (<text>.this //signature.parameters_start)) (<>.before (<text>.this //signature.parameters_end)) (<>.default (list)))] - (wrap (//.class name parameters))) + (in (//.class name parameters))) (<>.after (<text>.this //descriptor.class_prefix)) (<>.before (<text>.this //descriptor.class_suffix)))) @@ -127,5 +127,5 @@ inputs (..inputs aliasing) return (..return aliasing) exceptions (<>.some (..exception aliasing))] - (wrap (//.method [type_variables inputs return exceptions])))) + (in (//.method [type_variables inputs return exceptions])))) try.assumed)) diff --git a/stdlib/source/library/lux/target/jvm/type/lux.lux b/stdlib/source/library/lux/target/jvm/type/lux.lux index ea9df2259..3224c9a24 100644 --- a/stdlib/source/library/lux/target/jvm/type/lux.lux +++ b/stdlib/source/library/lux/target/jvm/type/lux.lux @@ -49,13 +49,13 @@ (def: void (Parser (Check Type)) (<>.after //parser.void - (<>\wrap (check\wrap .Any)))) + (<>\in (check\in .Any)))) (template [<name> <parser> <reflection>] [(def: <name> (Parser (Check Type)) (<>.after <parser> - (<>\wrap (check\wrap (#.Primitive (//reflection.reflection <reflection>) #.Nil)))))] + (<>\in (check\in (#.Primitive (//reflection.reflection <reflection>) #.Nil)))))] [boolean //parser.boolean //reflection.boolean] [byte //parser.byte //reflection.byte] @@ -71,7 +71,7 @@ [(def: <name> (Parser (Check Type)) (<>.after <parser> - (<>\wrap (check\wrap (#.Primitive <box> #.Nil)))))] + (<>\in (check\in (#.Primitive <box> #.Nil)))))] [boxed_boolean //parser.boolean //box.boolean] [boxed_byte //parser.byte //box.byte] @@ -112,19 +112,19 @@ (def: wildcard (Parser (Check Type)) (<>.after //parser.wildcard - (<>\wrap (check\map product.right - check.existential)))) + (<>\in (check\map product.right + check.existential)))) (def: (var mapping) (-> Mapping (Parser (Check Type))) (do <>.monad [var //parser.var'] - (wrap (case (dictionary.get var mapping) - #.None - (check.throw ..unknown_var [var]) - - (#.Some type) - (check\wrap type))))) + (in (case (dictionary.get var mapping) + #.None + (check.except ..unknown_var [var]) + + (#.Some type) + (check\in type))))) (def: (class' parameter) (-> (Parser (Check Type)) (Parser (Check Type))) @@ -134,9 +134,9 @@ (<>.after (<text>.this //signature.parameters_start)) (<>.before (<text>.this //signature.parameters_end)) (<>.default (list)))] - (wrap (do {! check.monad} - [parameters (monad.seq ! parameters)] - (wrap (#.Primitive name parameters))))) + (in (do {! check.monad} + [parameters (monad.seq ! parameters)] + (in (#.Primitive name parameters))))) (<>.after (<text>.this //descriptor.class_prefix)) (<>.before (<text>.this //descriptor.class_suffix)))) diff --git a/stdlib/source/library/lux/target/jvm/type/parser.lux b/stdlib/source/library/lux/target/jvm/type/parser.lux index 5c8f218b9..b955ce0f7 100644 --- a/stdlib/source/library/lux/target/jvm/type/parser.lux +++ b/stdlib/source/library/lux/target/jvm/type/parser.lux @@ -26,7 +26,7 @@ [(def: #export <name> (Parser (Type <category>)) (<>.after (<text>.this (//signature.signature <signature>)) - (<>\wrap <type>)))] + (<>\in <type>)))] [Void void //signature.void //.void] [Primitive boolean //signature.boolean //.boolean] @@ -118,7 +118,7 @@ (<>.after (<text>.this //signature.parameters_start)) (<>.before (<text>.this //signature.parameters_end)) (<>.default (list)))] - (wrap [name parameters])) + (in [name parameters])) (<>.after (<text>.this //descriptor.class_prefix)) (<>.before (<text>.this //descriptor.class_suffix)))) diff --git a/stdlib/source/library/lux/target/lua.lux b/stdlib/source/library/lux/target/lua.lux index 3c76ad6c4..74a975754 100644 --- a/stdlib/source/library/lux/target/lua.lux +++ b/stdlib/source/library/lux/target/lua.lux @@ -370,14 +370,14 @@ (list.reverse clauses))) (syntax: (arity_inputs {arity <code>.nat}) - (wrap (case arity - 0 (.list) - _ (|> (dec arity) - (enum.range n.enum 0) - (list\map (|>> %.nat code.local_identifier)))))) + (in (case arity + 0 (.list) + _ (|> (dec arity) + (enum.range n.enum 0) + (list\map (|>> %.nat code.local_identifier)))))) (syntax: (arity_types {arity <code>.nat}) - (wrap (list.repeat arity (` ..Expression)))) + (in (list.repeat arity (` ..Expression)))) (template [<arity> <function>+] [(with_expansions [<apply> (template.identifier ["apply/" <arity>]) diff --git a/stdlib/source/library/lux/target/php.lux b/stdlib/source/library/lux/target/php.lux index 5ca2e0d58..10ef0dbd3 100644 --- a/stdlib/source/library/lux/target/php.lux +++ b/stdlib/source/library/lux/target/php.lux @@ -226,14 +226,14 @@ :abstraction))) (syntax: (arity_inputs {arity <code>.nat}) - (wrap (case arity - 0 (.list) - _ (|> (dec arity) - (enum.range n.enum 0) - (list\map (|>> %.nat code.local_identifier)))))) + (in (case arity + 0 (.list) + _ (|> (dec arity) + (enum.range n.enum 0) + (list\map (|>> %.nat code.local_identifier)))))) (syntax: (arity_types {arity <code>.nat}) - (wrap (list.repeat arity (` ..Expression)))) + (in (list.repeat arity (` ..Expression)))) (template [<arity> <function>+] [(with_expansions [<apply> (template.identifier ["apply/" <arity>]) diff --git a/stdlib/source/library/lux/target/python.lux b/stdlib/source/library/lux/target/python.lux index 3c8450b31..056426d2a 100644 --- a/stdlib/source/library/lux/target/python.lux +++ b/stdlib/source/library/lux/target/python.lux @@ -456,14 +456,14 @@ (list.reverse clauses))) (syntax: (arity_inputs {arity <code>.nat}) - (wrap (case arity - 0 (.list) - _ (|> (dec arity) - (enum.range n.enum 0) - (list\map (|>> %.nat code.local_identifier)))))) + (in (case arity + 0 (.list) + _ (|> (dec arity) + (enum.range n.enum 0) + (list\map (|>> %.nat code.local_identifier)))))) (syntax: (arity_types {arity <code>.nat}) - (wrap (list.repeat arity (` (Expression Any))))) + (in (list.repeat arity (` (Expression Any))))) (template [<arity> <function>+] [(with_expansions [<apply> (template.identifier ["apply/" <arity>]) diff --git a/stdlib/source/library/lux/target/r.lux b/stdlib/source/library/lux/target/r.lux index f6180c45c..11d080762 100644 --- a/stdlib/source/library/lux/target/r.lux +++ b/stdlib/source/library/lux/target/r.lux @@ -204,14 +204,14 @@ ")")))) (syntax: (arity_inputs {arity <code>.nat}) - (wrap (case arity - 0 (.list) - _ (|> arity - list.indices - (list\map (|>> %.nat code.local_identifier)))))) + (in (case arity + 0 (.list) + _ (|> arity + list.indices + (list\map (|>> %.nat code.local_identifier)))))) (syntax: (arity_types {arity <code>.nat}) - (wrap (list.repeat arity (` ..Expression)))) + (in (list.repeat arity (` ..Expression)))) (template [<arity> <function>+] [(with_expansions [<apply> (template.identifier ["apply/" <arity>]) diff --git a/stdlib/source/library/lux/target/ruby.lux b/stdlib/source/library/lux/target/ruby.lux index 1d28af979..497cae831 100644 --- a/stdlib/source/library/lux/target/ruby.lux +++ b/stdlib/source/library/lux/target/ruby.lux @@ -432,14 +432,14 @@ (list.reverse clauses))) (syntax: (arity_inputs {arity <code>.nat}) - (wrap (case arity - 0 (.list) - _ (|> (dec arity) - (enum.range n.enum 0) - (list\map (|>> %.nat code.local_identifier)))))) + (in (case arity + 0 (.list) + _ (|> (dec arity) + (enum.range n.enum 0) + (list\map (|>> %.nat code.local_identifier)))))) (syntax: (arity_types {arity <code>.nat}) - (wrap (list.repeat arity (` ..Expression)))) + (in (list.repeat arity (` ..Expression)))) (template [<arity> <function>+] [(with_expansions [<apply> (template.identifier ["apply/" <arity>]) diff --git a/stdlib/source/library/lux/target/scheme.lux b/stdlib/source/library/lux/target/scheme.lux index 6ebc254db..cb6878cb4 100644 --- a/stdlib/source/library/lux/target/scheme.lux +++ b/stdlib/source/library/lux/target/scheme.lux @@ -217,39 +217,39 @@ [car/1 "car"] [cdr/1 "cdr"] [raise/1 "raise"] - [error-object-message/1 "error-object-message"] - [make-vector/1 "make-vector"] - [vector-length/1 "vector-length"] + [error_object_message/1 "error-object-message"] + [make_vector/1 "make-vector"] + [vector_length/1 "vector-length"] [not/1 "not"] - [string-hash/1 "string-hash"] + [string_hash/1 "string-hash"] [reverse/1 "reverse"] [display/1 "display"] [exit/1 "exit"] - [string-length/1 "string-length"] - [load-relative/1 "load-relative"]]] + [string_length/1 "string-length"] + [load_relative/1 "load-relative"]]] [apply/2 [_0 _1] [Expression Expression] [[append/2 "append"] [cons/2 "cons"] - [make-vector/2 "make-vector"] - ## [vector-ref/2 "vector-ref"] - [list-tail/2 "list-tail"] + [make_vector/2 "make-vector"] + ## [vector_ref/2 "vector-ref"] + [list_tail/2 "list-tail"] [map/2 "map"] - [string-ref/2 "string-ref"] - [string-append/2 "string-append"] - [make-string/2 "make-string"]]] + [string_ref/2 "string-ref"] + [string_append/2 "string-append"] + [make_string/2 "make-string"]]] [apply/3 [_0 _1 _2] [Expression Expression Expression] [[substring/3 "substring"] - [vector-set!/3 "vector-set!"] - [string-contains/3 "string-contains"]]] + [vector_set!/3 "vector-set!"] + [string_contains/3 "string-contains"]]] [apply/5 [_0 _1 _2 _3 _4] [Expression Expression Expression Expression Expression] - [[vector-copy!/5 "vector-copy!"]]] + [[vector_copy!/5 "vector-copy!"]]] ) - ## TODO: define "vector-ref/2" like a normal apply/2 function. - ## "vector-ref/2" as an 'invoke' is problematic, since it only works + ## TODO: define "vector_ref/2" like a normal apply/2 function. + ## "vector_ref/2" as an 'invoke' is problematic, since it only works ## in Kawa. ## However, the way Kawa defines "vector-ref" causes trouble, ## because it does a runtime type-check which throws an error when @@ -261,7 +261,7 @@ ## 1. To carry on, and then, when it's time to compile the compiler ## itself into Scheme, switch from 'invoke' to normal 'vector-ref'. ## Either way, the 'invoke' needs to go away. - (def: #export (vector-ref/2 vector index) + (def: #export (vector_ref/2 vector index) (-> Expression Expression Computation) (..form (list (..var "invoke") vector (..symbol "getRaw") index))) @@ -287,10 +287,10 @@ [remainder/2 "remainder"] [quotient/2 "quotient"] [mod/2 "mod"] - [arithmetic-shift/2 "arithmetic-shift"] - [bitwise-and/2 "bitwise-and"] - [bitwise-ior/2 "bitwise-ior"] - [bitwise-xor/2 "bitwise-xor"] + [arithmetic_shift/2 "arithmetic-shift"] + [bitwise_and/2 "bitwise-and"] + [bitwise_ior/2 "bitwise-ior"] + [bitwise_xor/2 "bitwise-xor"] ) (template [<lux_name> <scheme_name>] diff --git a/stdlib/source/library/lux/test.lux b/stdlib/source/library/lux/test.lux index c3c67ff82..2faf51dd2 100644 --- a/stdlib/source/library/lux/test.lux +++ b/stdlib/source/library/lux/test.lux @@ -1,4 +1,5 @@ -(.module: {#.doc "Tools for unit & property-based/generative testing."} +(.module: + {#.doc "Tools for unit & property-based/generative testing."} [library [lux (#- and for) ["." meta] @@ -121,13 +122,13 @@ (-> Text Test) (|>> (format ..failure_prefix) [..failure_tally] - async\wrap - random\wrap)) + async\in + random\in)) (def: #export (assert message condition) {#.doc "Check that a condition is #1, and fail with the given message otherwise."} (-> Text Bit Assertion) - (<| async\wrap + (<| async\in (if condition [..success_tally (format ..success_prefix message)] [..failure_tally (format ..failure_prefix message)]))) @@ -135,7 +136,7 @@ (def: #export (test message condition) {#.doc "Check that a condition is #1, and fail with the given message otherwise."} (-> Text Bit Test) - (random\wrap (..assert message condition))) + (random\in (..assert message condition))) (def: #export (lift message random) (-> Text (Random Bit) Test) @@ -178,7 +179,7 @@ [prng' (do {! async.monad} [[tally documentation] instance] (if (..failed? tally) - (wrap [tally (times_failure seed documentation)]) + (in [tally (times_failure seed documentation)]) (case amount 1 instance _ (|> test @@ -270,7 +271,7 @@ (def: (|cover| coverage condition) (-> (List Name) Bit Test) (|> (..|cover'| coverage condition) - random\wrap)) + random\in)) (def: (|for| coverage test) (-> (List Name) Test Test) @@ -290,8 +291,8 @@ (syntax: (reference {name <code>.identifier}) (do meta.monad - [_ (meta.find_export name)] - (wrap (list (name_code name))))) + [_ (meta.export name)] + (in (list (name_code name))))) (def: coverage_separator Text @@ -322,10 +323,10 @@ (let [coverage (list\map (function (_ definition) (` ((~! ..reference) (~ definition)))) coverage)] - (wrap (list (` ((~! <function>) - (: (.List .Name) - (.list (~+ coverage))) - (~ condition)))))))] + (in (list (` ((~! <function>) + (: (.List .Name) + (.list (~+ coverage))) + (~ condition)))))))] [cover' ..|cover'|] [cover ..|cover|] @@ -336,10 +337,10 @@ (let [coverage (list\map (function (_ definition) (` ((~! ..reference) (~ definition)))) coverage)] - (wrap (list (` ((~! ..|for|) - (: (.List .Name) - (.list (~+ coverage))) - (~ test))))))) + (in (list (` ((~! ..|for|) + (: (.List .Name) + (.list (~+ coverage))) + (~ test))))))) (def: (covering' module coverage test) (-> Text Text Test Test) @@ -361,10 +362,10 @@ aggregate)) #.Nil) ..encode_coverage)]] - (wrap (list (` ((~! ..covering') - (~ (code.text module)) - (~ (code.text coverage)) - (~ test))))))) + (in (list (` ((~! ..covering') + (~ (code.text module)) + (~ (code.text coverage)) + (~ test))))))) (exception: #export (error_during_execution {error Text}) (exception.report @@ -374,7 +375,7 @@ (-> (List Test) Test) (case (list.size tests) 0 - (random\wrap (async\wrap [..start ""])) + (random\in (async\in [..start ""])) expected_tests (do random.monad @@ -413,7 +414,7 @@ (|> assertions (list\map product.right) (text.join_with ..separator))])) - (wrap [])))) + (in [])))) (run! test))) (list.enumeration tests)))]] - (wrap read!)))) + (in read!)))) diff --git a/stdlib/source/library/lux/time.lux b/stdlib/source/library/lux/time.lux index cf1f340c0..e726ad968 100644 --- a/stdlib/source/library/lux/time.lux +++ b/stdlib/source/library/lux/time.lux @@ -54,7 +54,7 @@ (<>.either (|> (<text>.at_most 3 <text>.decimal) (<>.codec n.decimal) (<>.after (<text>.this "."))) - (\ <>.monad wrap 0))) + (\ <>.monad in 0))) (template [<maximum> <parser> <exception> <sub_parser>] [(exception: #export (<exception> {value Nat}) @@ -68,8 +68,8 @@ (do <>.monad [value <sub_parser>] (if (n.< <maximum> value) - (wrap value) - (<>.lift (exception.throw <exception> [value])))))] + (in value) + (<>.lift (exception.except <exception> [value])))))] [..hours hour_parser invalid_hour ..section_parser] [..minutes minute_parser invalid_minute ..section_parser] @@ -90,7 +90,7 @@ (-> Nat (Try Time)) (if (n.< ..limit milli_seconds) (#try.Success (:abstraction milli_seconds)) - (exception.throw ..time_exceeds_a_day [milli_seconds]))) + (exception.except ..time_exceeds_a_day [milli_seconds]))) (def: #export to_millis (-> Time Nat) @@ -140,12 +140,12 @@ _ (<text>.this ..separator) utc_second ..second_parser utc_millis ..millis_parser] - (wrap (:abstraction - ($_ n.+ - (n.* utc_hour hour) - (n.* utc_minute minute) - (n.* utc_second second) - (n.* utc_millis millis))))))) + (in (:abstraction + ($_ n.+ + (n.* utc_hour hour) + (n.* utc_minute minute) + (n.* utc_second second) + (n.* utc_millis millis))))))) ) (def: (pad value) diff --git a/stdlib/source/library/lux/time/date.lux b/stdlib/source/library/lux/time/date.lux index c2ad8d025..79250a35e 100644 --- a/stdlib/source/library/lux/time/date.lux +++ b/stdlib/source/library/lux/time/date.lux @@ -11,7 +11,7 @@ ["." try (#+ Try)] ["." exception (#+ exception:)] ["<>" parser - ["<text>" text (#+ Parser)]]] + ["<.>" text (#+ Parser)]]] [data ["." maybe] ["." text ("#\." monoid)] @@ -80,7 +80,7 @@ {#year year #month month #day day})) - (exception.throw ..invalid_day [year month day]))) + (exception.except ..invalid_day [year month day]))) (def: #export epoch Date @@ -147,7 +147,7 @@ (<>.either (|> (<text>.at_most 3 <text>.decimal) (<>.codec n.decimal) (<>.after (<text>.this "."))) - (\ <>.monad wrap 0))) + (\ <>.monad in 0))) (template [<minimum> <maximum> <parser> <exception>] [(exception: #export (<exception> {value Nat}) @@ -162,8 +162,8 @@ [value ..section_parser] (if (and (n.>= <minimum> value) (n.<= <maximum> value)) - (wrap value) - (<>.lift (exception.throw <exception> [value])))))] + (in value) + (<>.lift (exception.except <exception> [value])))))] [1 12 month_parser invalid_month] ) diff --git a/stdlib/source/library/lux/time/day.lux b/stdlib/source/library/lux/time/day.lux index 157dd6c1f..d5379cdc1 100644 --- a/stdlib/source/library/lux/time/day.lux +++ b/stdlib/source/library/lux/time/day.lux @@ -118,4 +118,4 @@ [#..Friday] [#..Saturday] [#..Sunday]) - _ (exception.throw ..not_a_day_of_the_week [value])))) + _ (exception.except ..not_a_day_of_the_week [value])))) diff --git a/stdlib/source/library/lux/time/duration.lux b/stdlib/source/library/lux/time/duration.lux index bcc65a0d3..5e0907481 100644 --- a/stdlib/source/library/lux/time/duration.lux +++ b/stdlib/source/library/lux/time/duration.lux @@ -179,9 +179,9 @@ (..merge (..up minutes ..minute)) (..merge (..up seconds ..second)) (..merge (..up millis ..milli_second)))]] - (wrap (case sign - (#.Left _) (..inverse span) - (#.Right _) span))))) + (in (case sign + (#.Left _) (..inverse span) + (#.Right _) span))))) (implementation: #export codec (Codec Text Duration) diff --git a/stdlib/source/library/lux/time/instant.lux b/stdlib/source/library/lux/time/instant.lux index a73a603ba..8445ed977 100644 --- a/stdlib/source/library/lux/time/instant.lux +++ b/stdlib/source/library/lux/time/instant.lux @@ -139,13 +139,13 @@ _ (<text>.this ..date_suffix) time (\ ! map //.to_millis //.parser) _ (<text>.this ..time_suffix)] - (wrap (|> (if (i.< +0 days) - (|> duration.day - (duration.up (.nat (i.* -1 days))) - duration.inverse) - (duration.up (.nat days) duration.day)) - (duration.merge (duration.up time duration.milli_second)) - ..absolute)))) + (in (|> (if (i.< +0 days) + (|> duration.day + (duration.up (.nat (i.* -1 days))) + duration.inverse) + (duration.up (.nat days) duration.day)) + (duration.merge (duration.up time duration.milli_second)) + ..absolute)))) (implementation: #export codec {#.doc (doc "Based on ISO 8601." diff --git a/stdlib/source/library/lux/time/month.lux b/stdlib/source/library/lux/time/month.lux index 381094933..89dc069f2 100644 --- a/stdlib/source/library/lux/time/month.lux +++ b/stdlib/source/library/lux/time/month.lux @@ -89,7 +89,7 @@ (^template [<number> <month>] [<number> (#try.Success <month>)]) (<pairs>) - _ (exception.throw ..invalid_month [number]))) + _ (exception.except ..invalid_month [number]))) ) (implementation: #export hash @@ -222,4 +222,4 @@ [#..October] [#..November] [#..December]) - _ (exception.throw ..not_a_month_of_the_year [value])))) + _ (exception.except ..not_a_month_of_the_year [value])))) diff --git a/stdlib/source/library/lux/time/year.lux b/stdlib/source/library/lux/time/year.lux index b3f3e7ecf..5388b5ef8 100644 --- a/stdlib/source/library/lux/time/year.lux +++ b/stdlib/source/library/lux/time/year.lux @@ -40,7 +40,7 @@ (def: #export (year value) (-> Int (Try Year)) (case value - +0 (exception.throw ..there_is_no_year_0 []) + +0 (exception.except ..there_is_no_year_0 []) _ (#try.Success (:abstraction (..internal value))))) (def: #export value @@ -112,9 +112,9 @@ (def: #export parser (Parser Year) (do {! <>.monad} - [sign (<>.or (<t>.this "-") (wrap [])) + [sign (<>.or (<t>.this "-") (in [])) digits (<t>.many <t>.decimal) - raw_year (<>.codec i.decimal (wrap (text\compose "+" digits)))] + raw_year (<>.codec i.decimal (in (text\compose "+" digits)))] (<>.lift (..year (case sign (#.Left _) (i.* -1 raw_year) (#.Right _) raw_year))))) diff --git a/stdlib/source/library/lux/tool/compiler/default/init.lux b/stdlib/source/library/lux/tool/compiler/default/init.lux index 7fcbb94eb..8b668b60f 100644 --- a/stdlib/source/library/lux/tool/compiler/default/init.lux +++ b/stdlib/source/library/lux/tool/compiler/default/init.lux @@ -48,7 +48,8 @@ ["." archive (#+ Archive) ["." descriptor (#+ Module)] ["." artifact] - ["." document]]]]]) + ["." document]]]] + ]) (def: #export (state target module expander host_analysis host generate generation_bundle) (All [anchor expression directive] @@ -132,8 +133,8 @@ _ (monad.map ! module.import dependencies) #let [source (///analysis.source (get@ #///.module input) (get@ #///.code input))] _ (///analysis.set_source_code source)] - (wrap [source [///generation.empty_buffer - artifact.empty]]))))) + (in [source [///generation.empty_buffer + artifact.empty]]))))) (def: (end module) (-> Module @@ -150,8 +151,8 @@ ///generation.buffer) final_registry (///directive.lift_generation ///generation.get_registry)] - (wrap [analysis_module [final_buffer - final_registry]]))) + (in [analysis_module [final_buffer + final_registry]]))) ## TODO: Inline ASAP (def: (get_current_payload _) @@ -165,7 +166,7 @@ ///generation.buffer) registry (///directive.lift_generation ///generation.get_registry)] - (wrap [buffer registry]))) + (in [buffer registry]))) ## TODO: Inline ASAP (def: (process_directive archive expander pre_payoad code) @@ -183,7 +184,7 @@ requirements (let [execute! (directiveP.phase expander)] (execute! archive code)) post_payload (..get_current_payload pre_payoad)] - (wrap [requirements post_payload]))) + (in [requirements post_payload]))) (def: (iteration archive expander reader source pre_payload) (All [directive] @@ -195,7 +196,7 @@ [[source code] (///directive.lift_analysis (..read source reader)) [requirements post_payload] (process_directive archive expander pre_payload code)] - (wrap [source requirements post_payload]))) + (in [source requirements post_payload]))) (def: (iterate archive expander module source pre_payload aliases) (All [directive] @@ -255,33 +256,33 @@ #descriptor.references (set.of_list text.hash dependencies) #descriptor.state #.Compiled #descriptor.registry final_registry}]] - (wrap [state - (#.Right [descriptor - (document.write key analysis_module) - (row\map (function (_ [artifact_id custom directive]) - [artifact_id custom (write_directive directive)]) - final_buffer)])])) + (in [state + (#.Right [descriptor + (document.write key analysis_module) + (row\map (function (_ [artifact_id custom directive]) + [artifact_id custom (write_directive directive)]) + final_buffer)])])) (#.Some [source requirements temporary_payload]) (let [[temporary_buffer temporary_registry] temporary_payload] - (wrap [state - (#.Left {#///.dependencies (|> requirements - (get@ #///directive.imports) - (list\map product.left)) - #///.process (function (_ state archive) - (recur (<| (///phase.run' state) - (do {! ///phase.monad} - [analysis_module (<| (: (Operation .Module)) - ///directive.lift_analysis - extension.lift - meta.current_module) - _ (///directive.lift_generation - (///generation.set_buffer temporary_buffer)) - _ (///directive.lift_generation - (///generation.set_registry temporary_registry)) - _ (|> requirements - (get@ #///directive.referrals) - (monad.map ! (execute! archive))) - temporary_payload (..get_current_payload temporary_payload)] - (..iterate archive expander module source temporary_payload (..module_aliases analysis_module))))))})])) + (in [state + (#.Left {#///.dependencies (|> requirements + (get@ #///directive.imports) + (list\map product.left)) + #///.process (function (_ state archive) + (recur (<| (///phase.run' state) + (do {! ///phase.monad} + [analysis_module (<| (: (Operation .Module)) + ///directive.lift_analysis + extension.lift + meta.current_module) + _ (///directive.lift_generation + (///generation.set_buffer temporary_buffer)) + _ (///directive.lift_generation + (///generation.set_registry temporary_registry)) + _ (|> requirements + (get@ #///directive.referrals) + (monad.map ! (execute! archive))) + temporary_payload (..get_current_payload temporary_payload)] + (..iterate archive expander module source temporary_payload (..module_aliases analysis_module))))))})])) )))))})))) diff --git a/stdlib/source/library/lux/tool/compiler/default/platform.lux b/stdlib/source/library/lux/tool/compiler/default/platform.lux index c60700019..8a3d4a1cd 100644 --- a/stdlib/source/library/lux/tool/compiler/default/platform.lux +++ b/stdlib/source/library/lux/tool/compiler/default/platform.lux @@ -2,8 +2,8 @@ [library [lux (#- Module) [type (#+ :sharing)] - ["." debug] ["@" target] + ["." debug] [abstract ["." monad (#+ Monad do)]] [control @@ -58,9 +58,9 @@ ["ioW" archive]]]]] [program [compositor - ["." cli (#+ Compilation Library)] - ["." static (#+ Static)] - ["." import (#+ Import)]]]) + [cli (#+ Compilation Library)] + [import (#+ Import)] + ["." static (#+ Static)]]]) (with_expansions [<type_vars> (as_is anchor expression directive) <Operation> (as_is ///generation.Operation <type_vars>)] @@ -112,7 +112,7 @@ row.to_list (monad.map ..monad write_artifact!) (: (Action (List Any))))) - document (\ async.monad wrap + document (\ async.monad in (document.check $.key document))] (ioW.cache system static module_id (_.run ..writer [descriptor document]))))) @@ -158,7 +158,7 @@ (do try.monad [[_ archive] (archive.reserve archive.runtime_module archive)] (archive.add archive.runtime_module [descriptor document payload] archive))))] - (wrap [archive [descriptor document payload]]))) + (in [archive [descriptor document payload]]))) (def: (initialize_state extender [analysers @@ -191,7 +191,7 @@ _ (///directive.lift_generation (extension.with extender (:assume generators))) _ (extension.with extender (:assume directives))] - (wrap []))) + (in []))) (///phase.run' state) (\ try.monad map product.left))) @@ -249,7 +249,7 @@ (: (All [<type_vars>] (-> <Platform> (Program expression directive) <State+> (Async (Try <State+>)))) (function (_ platform program state) - (async\wrap + (async\in (do try.monad [[state phase_wrapper] (..phase_wrapper archive platform state)] (|> state @@ -260,15 +260,15 @@ (if (archive.archived? archive archive.runtime_module) (do ! [state (with_missing_extensions platform program state)] - (wrap [state archive])) + (in [state archive])) (do ! [[state [archive payload]] (|> (..process_runtime archive platform) (///phase.run' state) - async\wrap) + async\in) _ (..cache_module static platform 0 payload) state (with_missing_extensions platform program state)] - (wrap [state archive]))))) + (in [state archive]))))) (def: compilation_log_separator (format text.new_line text.tab)) @@ -369,10 +369,10 @@ (def: (verify_dependencies importer importee dependence) (-> Module Module Dependence (Try Any)) (cond (text\= importer importee) - (exception.throw ..module_cannot_import_itself [importer]) + (exception.except ..module_cannot_import_itself [importer]) (..circular_dependency? importer importee dependence) - (exception.throw ..cannot_import_circular_dependency [importer importee]) + (exception.except ..cannot_import_circular_dependency [importer importee]) ## else (#try.Success []))) @@ -414,30 +414,30 @@ (stm.read dependence) (do ! [[_ dependence] (stm.update (..depend importer module) dependence)] - (wrap dependence)))] + (in dependence)))] (case (..verify_dependencies importer module dependence) (#try.Failure error) - (wrap [(async.resolved (#try.Failure error)) - #.None]) + (in [(async.resolved (#try.Failure error)) + #.None]) (#try.Success _) (do ! [[archive state] (stm.read current)] (if (archive.archived? archive module) - (wrap [(async\wrap (#try.Success [archive state])) - #.None]) + (in [(async\in (#try.Success [archive state])) + #.None]) (do ! [@pending (stm.read pending)] (case (dictionary.get module @pending) (#.Some [return signal]) - (wrap [return - #.None]) + (in [return + #.None]) #.None (case (if (archive.reserved? archive module) (do try.monad [module_id (archive.id module archive)] - (wrap [module_id archive])) + (in [module_id archive])) (archive.reserve module archive)) (#try.Success [module_id archive]) (do ! @@ -449,24 +449,24 @@ <Pending> (async.async []))] _ (stm.update (dictionary.put module [return signal]) pending)] - (wrap [return - (#.Some [[archive state] - module_id - signal])])) + (in [return + (#.Some [[archive state] + module_id + signal])])) (#try.Failure error) - (wrap [(async\wrap (#try.Failure error)) - #.None]))))))))))) + (in [(async\in (#try.Failure error)) + #.None]))))))))))) _ (case signal #.None - (wrap []) + (in []) (#.Some [context module_id resolver]) (do ! [result (compile importer import! module_id context module) result (case result (#try.Failure error) - (wrap result) + (in result) (#try.Success [resulting_archive resulting_state]) (stm.commit (do stm.monad @@ -474,9 +474,9 @@ [(archive.merge resulting_archive archive) state]) current)] - (wrap (#try.Success [merged_archive resulting_state]))))) + (in (#try.Success [merged_archive resulting_state]))))) _ (async.future (resolver result))] - (wrap [])))] + (in [])))] return))))) ## TODO: Find a better way, as this only works for the Lux compiler. @@ -488,26 +488,26 @@ (do ! [[descriptor document output] (archive.find module archive) lux_module (document.read $.key document)] - (wrap [module lux_module]))) + (in [module lux_module]))) (archive.archived archive)) #let [additions (|> modules (list\map product.left) (set.of_list text.hash))]] - (wrap (update@ [#extension.state - #///directive.analysis - #///directive.state - #extension.state] - (function (_ analysis_state) - (|> analysis_state - (:as .Lux) - (update@ #.modules (function (_ current) - (list\compose (list.only (|>> product.left - (set.member? additions) - not) - current) - modules))) - :assume)) - state)))) + (in (update@ [#extension.state + #///directive.analysis + #///directive.state + #extension.state] + (function (_ analysis_state) + (|> analysis_state + (:as .Lux) + (update@ #.modules (function (_ current) + (list\compose (list.only (|>> product.left + (set.member? additions) + not) + current) + modules))) + :assume)) + state)))) (def: (set_current_module module state) (All [<type_vars>] @@ -556,7 +556,7 @@ (do ! [[archive state] (case new_dependencies #.Nil - (wrap [archive state]) + (in [archive state]) (#.Cons _) (do ! @@ -566,8 +566,8 @@ #let [archive (|> archive,document+ (list\map product.left) (list\fold archive.merge archive))]] - (wrap [archive (try.assumed - (..updated_state archive state))])))] + (in [archive (try.assumed + (..updated_state archive state))])))] (case ((get@ #///.process compilation) ## TODO: The "///directive.set_current_module" below shouldn't be necessary. Remove it ASAP. ## TODO: The context shouldn't need to be re-set either. @@ -588,15 +588,15 @@ _ (..cache_module static platform module_id [descriptor document output])] (case (archive.add module [descriptor document output] archive) (#try.Success archive) - (wrap [archive - (..with_reset_log state)]) + (in [archive + (..with_reset_log state)]) (#try.Failure error) - (async\wrap (#try.Failure error))))) + (async\in (#try.Failure error))))) (#try.Failure error) (do ! [_ (ioW.freeze (get@ #&file_system platform) static archive)] - (async\wrap (#try.Failure error))))))))))] + (async\in (#try.Failure error))))))))))] (compiler archive.runtime_module compilation_module))) ))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux.lux b/stdlib/source/library/lux/tool/compiler/language/lux.lux index e6d5816a4..e5c8e654d 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux.lux @@ -98,7 +98,7 @@ ## #module_annotations (<b>.maybe <b>.code) ## #module_state - (\ <>.monad wrap #.Cached)))) + (\ <>.monad in #.Cached)))) (def: #export key (Key .Module) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/analysis.lux b/stdlib/source/library/lux/tool/compiler/language/lux/analysis.lux index 0fc5d90fc..b2b7b6c18 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/analysis.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis.lux @@ -469,22 +469,22 @@ (function (_ [bundle state]) (#try.Failure (locate_error (get@ #.location state) error)))) -(def: #export (throw exception parameters) +(def: #export (except exception parameters) (All [e] (-> (Exception e) e Operation)) (..failure (exception.construct exception parameters))) (def: #export (assert exception parameters condition) (All [e] (-> (Exception e) e Bit (Operation Any))) (if condition - (\ phase.monad wrap []) - (..throw exception parameters))) + (\ phase.monad in []) + (..except exception parameters))) (def: #export (failure' error) (-> Text (phase.Operation Lux)) (function (_ state) (#try.Failure (locate_error (get@ #.location state) error)))) -(def: #export (throw' exception parameters) +(def: #export (except' exception parameters) (All [e] (-> (Exception e) e (phase.Operation Lux))) (..failure' (exception.construct exception parameters))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/macro.lux b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/macro.lux index f8f295429..ecc765794 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/macro.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/macro.lux @@ -46,7 +46,7 @@ [expansion (expand expander name macro inputs)] (case expansion (^ (list single)) - (wrap single) + (in single) _ (meta.failure (exception.construct ..must_have_single_expansion [name inputs expansion]))))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/generation.lux b/stdlib/source/library/lux/tool/compiler/language/lux/generation.lux index 29796ead6..bbe6da451 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/generation.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/generation.lux @@ -128,7 +128,7 @@ (#try.Success [stateE output]) #.None - (exception.throw <exception> [])))) + (exception.except <exception> [])))) (def: #export (<set> value) (All [anchor expression directive] @@ -171,7 +171,7 @@ (do phase.monad [count (extension.read (get@ #counter)) _ (extension.update (update@ #counter inc))] - (wrap count))) + (in count))) (def: #export (gensym prefix) (All [anchor expression directive] @@ -197,7 +197,7 @@ (#try.Success [state+ output]) (#try.Failure error) - (exception.throw ..cannot_interpret error)))) + (exception.except ..cannot_interpret error)))) (def: #export (execute! code) (All [anchor expression directive] @@ -208,7 +208,7 @@ (#try.Success [state+ output]) (#try.Failure error) - (exception.throw ..cannot_interpret error)))) + (exception.except ..cannot_interpret error)))) (def: #export (define! context custom code) (All [anchor expression directive] @@ -219,7 +219,7 @@ (#try.Success [stateE output]) (#try.Failure error) - (exception.throw ..cannot_interpret error)))) + (exception.except ..cannot_interpret error)))) (def: #export (save! artifact_id custom code) (All [anchor expression directive] @@ -230,11 +230,11 @@ (#.Some buffer) ## TODO: Optimize by no longer checking for overwrites... (if (row.any? (|>> product.left (n.= artifact_id)) buffer) - (phase.throw ..cannot_overwrite_output [artifact_id]) + (phase.except ..cannot_overwrite_output [artifact_id]) (extension.update (set@ #buffer (#.Some (row.add [artifact_id custom code] buffer))))) #.None - (phase.throw ..no_buffer_for_saving_code [artifact_id])))) + (phase.except ..no_buffer_for_saving_code [artifact_id])))) (template [<name> <artifact>] [(def: #export (<name> name) @@ -274,7 +274,7 @@ (#try.Success (get@ #descriptor.registry descriptor))))] (case (artifact.remember _name registry) #.None - (exception.throw ..unknown_definition [name (artifact.definitions registry)]) + (exception.except ..unknown_definition [name (artifact.definitions registry)]) (#.Some id) (#try.Success [stateE [module_id id]])))))) @@ -287,7 +287,7 @@ (function (_ (^@ stateE [bundle state])) (do try.monad [module_id (archive.id module archive)] - (wrap [stateE module_id])))) + (in [stateE module_id])))) (def: #export (context archive) (All [anchor expression directive] @@ -295,12 +295,12 @@ (function (_ (^@ stateE [bundle state])) (case (get@ #context state) #.None - (exception.throw ..no_context []) + (exception.except ..no_context []) (#.Some id) (do try.monad [module_id (archive.id (get@ #module state) archive)] - (wrap [stateE [module_id id]]))))) + (in [stateE [module_id id]]))))) (def: #export (with_context id body) (All [anchor expression directive a] @@ -310,8 +310,8 @@ (function (_ [bundle state]) (do try.monad [[[bundle' state'] output] (body [bundle (set@ #context (#.Some id) state)])] - (wrap [[bundle' (set@ #context (get@ #context state) state')] - output])))) + (in [[bundle' (set@ #context (get@ #context state) state')] + output])))) (def: #export (with_new_context archive body) (All [anchor expression directive a] @@ -324,9 +324,9 @@ (set@ #registry registry') (set@ #context (#.Some id)))]) module_id (archive.id (get@ #module state) archive)] - (wrap [[bundle' (set@ #context (get@ #context state) state')] - [[module_id id] - output]]))))) + (in [[bundle' (set@ #context (get@ #context state) state')] + [[module_id id] + output]]))))) (def: #export (log! message) (All [anchor expression directive a] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis.lux index c35404a68..b2a5e9fc6 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis.lux @@ -116,7 +116,7 @@ (case functionA (#/.Reference (#reference.Constant def_name)) (do ! - [?macro (//extension.lift (meta.find_macro def_name))] + [?macro (//extension.lift (meta.macro def_name))] (case ?macro (#.Some macro) (do ! @@ -130,7 +130,7 @@ (/function.apply compile argsC+ functionT functionA archive functionC))) _ - (//.throw ..unrecognized_syntax [location.dummy code']))) + (//.except ..unrecognized_syntax [location.dummy code']))) (def: #export (phase expander) (-> Expander Phase) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case.lux index 54e4e90d6..fb8d67bf5 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case.lux @@ -90,7 +90,7 @@ (recur envs caseT') _ - (/.throw ..cannot_simplify_for_pattern_matching caseT))) + (/.except ..cannot_simplify_for_pattern_matching caseT))) (#.Named name unnamedT) (recur envs unnamedT) @@ -102,7 +102,7 @@ (do ///.monad [[var_id varT] (//type.with_env check.var)] - (recur envs (maybe.assume (type.apply (list varT) caseT)))) + (recur envs (maybe.assume (type.applied (list varT) caseT)))) (#.Apply inputT funcT) (.case funcT @@ -113,29 +113,29 @@ [?funct' (check.read funcT_id)] (.case ?funct' (#.Some funct') - (wrap funct') + (in funct') _ - (check.throw ..cannot_simplify_for_pattern_matching caseT))))] + (check.except ..cannot_simplify_for_pattern_matching caseT))))] (recur envs (#.Apply inputT funcT'))) _ - (.case (type.apply (list inputT) funcT) + (.case (type.applied (list inputT) funcT) (#.Some outputT) (recur envs outputT) #.None - (/.throw ..cannot_simplify_for_pattern_matching caseT))) + (/.except ..cannot_simplify_for_pattern_matching caseT))) (#.Product _) (|> caseT type.flat_tuple (list\map (re_quantify envs)) type.tuple - (\ ///.monad wrap)) + (\ ///.monad in)) _ - (\ ///.monad wrap (re_quantify envs caseT))))) + (\ ///.monad in (re_quantify envs caseT))))) (def: (analyse_primitive type inputT location output next) (All [a] (-> Type Type Location Pattern (Operation a) (Operation [Pattern a]))) @@ -144,7 +144,7 @@ [_ (//type.with_env (check.check inputT type)) outputA next] - (wrap [output outputA])))) + (in [output outputA])))) ## This function handles several concerns at once, but it must be that ## way because those concerns are interleaved when doing @@ -171,7 +171,7 @@ [outputA (//scope.with_local [name inputT] next) idx //scope.next_local] - (wrap [(#/.Bind idx) outputA]))) + (in [(#/.Bind idx) outputA]))) (^template [<type> <input> <output>] [[location <input>] @@ -216,16 +216,16 @@ [[memberP [memberP+ thenA]] ((:as (All [a] (-> (Maybe Nat) Type Code (Operation a) (Operation [Pattern a]))) analyse_pattern) #.None memberT memberC then)] - (wrap [(list& memberP memberP+) thenA])))) + (in [(list& memberP memberP+) thenA])))) (do ! [nextA next] - (wrap [(list) nextA])) + (in [(list) nextA])) (list.reverse matches))] - (wrap [(/.pattern/tuple memberP+) - thenA]))) + (in [(/.pattern/tuple memberP+) + thenA]))) _ - (/.throw ..cannot_match_with_pattern [inputT' pattern]) + (/.except ..cannot_match_with_pattern [inputT' pattern]) ))) [location (#.Record record)] @@ -238,7 +238,7 @@ (check.check inputT recordT)) _ - (wrap []))] + (in []))] (analyse_pattern (#.Some (list.size members)) inputT [location (#.Tuple members)] next)) [location (#.Tag tag)] @@ -266,23 +266,23 @@ (` [(~+ values)]) next) (analyse_pattern #.None caseT (` [(~+ values)]) next))] - (wrap [(/.pattern/variant [lefts right? testP]) - nextA])) + (in [(/.pattern/variant [lefts right? testP]) + nextA])) _ - (/.throw ..sum_has_no_case [idx inputT]))) + (/.except ..sum_has_no_case [idx inputT]))) (#.UnivQ _) (do ///.monad [[ex_id exT] (//type.with_env check.existential)] (analyse_pattern num_tags - (maybe.assume (type.apply (list exT) inputT')) + (maybe.assume (type.applied (list exT) inputT')) pattern next)) _ - (/.throw ..cannot_match_with_pattern [inputT' pattern])))) + (/.except ..cannot_match_with_pattern [inputT' pattern])))) (^ [location (#.Form (list& [_ (#.Tag tag)] values))]) (/.with_location location @@ -295,7 +295,7 @@ (analyse_pattern (#.Some (list.size group)) inputT (` ((~ (code.nat lefts)) (~ (code.bit right?)) (~+ values))) next))) _ - (/.throw ..not_a_pattern pattern) + (/.except ..not_a_pattern pattern) )) (def: #export (case analyse branches archive inputC) @@ -319,7 +319,7 @@ (#try.Failure error) (/.failure error))] - (wrap (#/.Case inputA [outputH outputT]))) + (in (#/.Case inputA [outputH outputT]))) #.Nil - (/.throw ..cannot_have_empty_branches ""))) + (/.except ..cannot_have_empty_branches ""))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case/coverage.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case/coverage.lux index 2bb0fe957..37177e7ba 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case/coverage.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/case/coverage.lux @@ -99,13 +99,13 @@ (case pattern (^or (#/.Simple #/.Unit) (#/.Bind _)) - (////\wrap #Exhaustive) + (////\in #Exhaustive) ## Primitive patterns always have partial coverage because there ## are too many possibilities as far as values go. (^template [<tag>] [(#/.Simple (<tag> _)) - (////\wrap #Partial)]) + (////\in #Partial)]) ([#/.Nat] [#/.Int] [#/.Rev] @@ -116,14 +116,14 @@ ## "#0", which means it is possible for bit ## pattern-matching to become exhaustive if complementary parts meet. (#/.Simple (#/.Bit value)) - (////\wrap (#Bit value)) + (////\in (#Bit value)) ## Tuple patterns can be exhaustive if there is exhaustiveness for all of ## their sub-patterns. (#/.Complex (#/.Tuple membersP+)) (case (list.reverse membersP+) (^or #.Nil (#.Cons _ #.Nil)) - (/.throw ..invalid_tuple_pattern []) + (/.except ..invalid_tuple_pattern []) (#.Cons lastP prevsP+) (do ////.monad @@ -134,10 +134,10 @@ [leftC (determine leftP)] (case rightC #Exhaustive - (wrap leftC) + (in leftC) _ - (wrap (#Seq leftC rightC))))) + (in (#Seq leftC rightC))))) lastC prevsP+))) ## Variant patterns can be shown to be exhaustive if all the possible @@ -148,11 +148,11 @@ #let [idx (if right? (inc lefts) lefts)]] - (wrap (#Variant (if right? - (#.Some idx) - #.None) - (|> (dictionary.new n.hash) - (dictionary.put idx value_coverage))))))) + (in (#Variant (if right? + (#.Some idx) + #.None) + (|> (dictionary.new n.hash) + (dictionary.put idx value_coverage))))))) (def: (xor left right) (-> Bit Bit Bit) @@ -221,12 +221,12 @@ (-> Coverage Coverage (Try Coverage)) (case [addition so_far] [#Partial #Partial] - (try\wrap #Partial) + (try\in #Partial) ## 2 bit coverages are exhaustive if they complement one another. (^multi [(#Bit sideA) (#Bit sideSF)] (xor sideA sideSF)) - (try\wrap #Exhaustive) + (try\in #Exhaustive) [(#Variant allA casesA) (#Variant allSF casesSF)] (let [addition_cases (cases allSF) @@ -234,10 +234,10 @@ (cond (and (known_cases? addition_cases) (known_cases? so_far_cases) (not (n.= addition_cases so_far_cases))) - (ex.throw ..variants_do_not_match [addition_cases so_far_cases]) + (ex.except ..variants_do_not_match [addition_cases so_far_cases]) (\ (dictionary.equivalence ..equivalence) = casesSF casesA) - (ex.throw ..redundant_pattern [so_far addition]) + (ex.except ..redundant_pattern [so_far addition]) ## else (do {! try.monad} @@ -247,24 +247,24 @@ (#.Some coverageSF) (do ! [coverageM (merge coverageA coverageSF)] - (wrap (dictionary.put tagA coverageM casesSF'))) + (in (dictionary.put tagA coverageM casesSF'))) #.None - (wrap (dictionary.put tagA coverageA casesSF')))) + (in (dictionary.put tagA coverageA casesSF')))) casesSF (dictionary.entries casesA))] - (wrap (if (and (or (known_cases? addition_cases) - (known_cases? so_far_cases)) - (n.= (inc (n.max addition_cases so_far_cases)) - (dictionary.size casesM)) - (list.every? exhaustive? (dictionary.values casesM))) - #Exhaustive - (#Variant (case allSF - (#.Some _) - allSF - - _ - allA) - casesM)))))) + (in (if (and (or (known_cases? addition_cases) + (known_cases? so_far_cases)) + (n.= (inc (n.max addition_cases so_far_cases)) + (dictionary.size casesM)) + (list.every? exhaustive? (dictionary.values casesM))) + #Exhaustive + (#Variant (case allSF + (#.Some _) + allSF + + _ + allA) + casesM)))))) [(#Seq leftA rightA) (#Seq leftSF rightSF)] (case [(coverage/= leftSF leftA) (coverage/= rightSF rightA)] @@ -276,40 +276,40 @@ ## If all that follows is exhaustive, then it can be safely dropped ## (since only the "left" part would influence whether the ## merged coverage is exhaustive or not). - (wrap leftSF) - (wrap (#Seq leftSF rightM)))) + (in leftSF) + (in (#Seq leftSF rightM)))) ## Same suffix [#0 #1] (do try.monad [leftM (merge leftA leftSF)] - (wrap (#Seq leftM rightA))) + (in (#Seq leftM rightA))) ## The 2 sequences cannot possibly be merged. [#0 #0] - (try\wrap (#Alt so_far addition)) + (try\in (#Alt so_far addition)) ## There is nothing the addition adds to the coverage. [#1 #1] - (ex.throw ..redundant_pattern [so_far addition])) + (ex.except ..redundant_pattern [so_far addition])) ## The addition cannot possibly improve the coverage. [_ #Exhaustive] - (ex.throw ..redundant_pattern [so_far addition]) + (ex.except ..redundant_pattern [so_far addition]) ## The addition completes the coverage. [#Exhaustive _] - (try\wrap #Exhaustive) + (try\in #Exhaustive) ## The left part will always match, so the addition is redundant. (^multi [(#Seq left right) single] (coverage/= left single)) - (ex.throw ..redundant_pattern [so_far addition]) + (ex.except ..redundant_pattern [so_far addition]) ## The right part is not necessary, since it can always match the left. (^multi [single (#Seq left right)] (coverage/= left single)) - (try\wrap single) + (try\in single) ## When merging a new coverage against one based on Alt, it may be ## that one of the many coverages in the Alt is complementary to @@ -329,7 +329,7 @@ (loop [altsSF possibilitiesSF] (case altsSF #.Nil - (wrap [#.None (list coverageA)]) + (in [#.None (list coverageA)]) (#.Cons altSF altsSF') (case (merge coverageA altSF) @@ -338,13 +338,13 @@ (#Alt _) (do ! [[success altsSF+] (recur altsSF')] - (wrap [success (#.Cons altSF altsSF+)])) + (in [success (#.Cons altSF altsSF+)])) _ - (wrap [(#.Some altMSF) altsSF'])) + (in [(#.Some altMSF) altsSF'])) (#try.Failure error) - (try.failure error)) + (#try.Failure error)) ))))] [successA possibilitiesSF] (fuse_once addition (flat_alt so_far))] (loop [successA successA @@ -358,9 +358,9 @@ #.None (case (list.reverse possibilitiesSF) (#.Cons last prevs) - (wrap (list\fold (function (_ left right) (#Alt left right)) - last - prevs)) + (in (list\fold (function (_ left right) (#Alt left right)) + last + prevs)) #.Nil (undefined))))) @@ -368,6 +368,6 @@ _ (if (coverage/= so_far addition) ## The addition cannot possibly improve the coverage. - (ex.throw ..redundant_pattern [so_far addition]) + (ex.except ..redundant_pattern [so_far addition]) ## There are now 2 alternative paths. - (try\wrap (#Alt so_far addition))))) + (try\in (#Alt so_far addition))))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/function.lux index 1ef5c88c4..7fb985f4b 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/function.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/function.lux @@ -53,7 +53,7 @@ (recur unnamedT) (#.Apply argT funT) - (case (type.apply (list argT) funT) + (case (type.applied (list argT) funT) (#.Some value) (recur value) @@ -64,7 +64,7 @@ [(<tag> _) (do ! [[_ instanceT] (//type.with_env <instancer>)] - (recur (maybe.assume (type.apply (list instanceT) expectedT))))]) + (recur (maybe.assume (type.applied (list instanceT) expectedT))))]) ([#.UnivQ check.existential] [#.ExQ check.var]) @@ -85,7 +85,7 @@ functionA (recur functionT) _ (//type.with_env (check.check expectedT functionT))] - (wrap functionA)) + (in functionA)) )) (#.Function inputT outputT) @@ -110,4 +110,4 @@ (<| (/.with_stack ..cannot_apply [functionT functionC argsC+]) (do ///.monad [[applyT argsA+] (//inference.general archive analyse functionT argsC+)]) - (wrap (/.apply [functionA argsA+])))) + (in (/.apply [functionA argsA+])))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/inference.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/inference.lux index ace669fbe..abdf5b806 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/inference.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/inference.lux @@ -98,7 +98,7 @@ (do ///.monad [location (///extension.lift meta.location) [ex_id _] (//type.with_env check.existential)] - (wrap (named_type location ex_id)))) + (in (named_type location ex_id)))) ## Type-inference works by applying some (potentially quantified) type ## to a sequence of values. @@ -113,7 +113,7 @@ #.Nil (do ///.monad [_ (//type.infer inferT)] - (wrap [inferT (list)])) + (in [inferT (list)])) (#.Cons argC args') (case inferT @@ -123,31 +123,31 @@ (#.UnivQ _) (do ///.monad [[var_id varT] (//type.with_env check.var)] - (general archive analyse (maybe.assume (type.apply (list varT) inferT)) args)) + (general archive analyse (maybe.assume (type.applied (list varT) inferT)) args)) (#.ExQ _) (do {! ///.monad} [[var_id varT] (//type.with_env check.var) output (general archive analyse - (maybe.assume (type.apply (list varT) inferT)) + (maybe.assume (type.applied (list varT) inferT)) args) bound? (//type.with_env (check.bound? var_id)) _ (if bound? - (wrap []) + (in []) (do ! [newT new_named_type] (//type.with_env (check.check varT newT))))] - (wrap output)) + (in output)) (#.Apply inputT transT) - (case (type.apply (list inputT) transT) + (case (type.applied (list inputT) transT) (#.Some outputT) (general archive analyse outputT args) #.None - (/.throw ..invalid_type_application inferT)) + (/.except ..invalid_type_application inferT)) ## Arguments are inferred back-to-front because, by convention, ## Lux functions take the most important arguments *last*, which @@ -162,7 +162,7 @@ argA (<| (/.with_stack ..cannot_infer_argument [inputT argC]) (//type.with_type inputT) (analyse archive argC))] - (wrap [outputT' (list& argA args'A)])) + (in [outputT' (list& argA args'A)])) (#.Var infer_id) (do ///.monad @@ -172,10 +172,10 @@ (general archive analyse inferT' args) _ - (/.throw ..cannot_infer [inferT args]))) + (/.except ..cannot_infer [inferT args]))) _ - (/.throw ..cannot_infer [inferT args])) + (/.except ..cannot_infer [inferT args])) )) (def: (substitute_bound target sub) @@ -214,25 +214,25 @@ [(<tag> env bodyT) (do ///.monad [bodyT+ (record' (n.+ 2 target) originalT bodyT)] - (wrap (<tag> env bodyT+)))]) + (in (<tag> env bodyT+)))]) ([#.UnivQ] [#.ExQ]) (#.Apply inputT funcT) - (case (type.apply (list inputT) funcT) + (case (type.applied (list inputT) funcT) (#.Some outputT) (record' target originalT outputT) #.None - (/.throw ..invalid_type_application inferT)) + (/.except ..invalid_type_application inferT)) (#.Product _) - (///\wrap (|> inferT - (type.function (type.flat_tuple inferT)) - (substitute_bound target originalT))) + (///\in (|> inferT + (type.function (type.flat_tuple inferT)) + (substitute_bound target originalT))) _ - (/.throw ..not_a_record_type inferT))) + (/.except ..not_a_record_type inferT))) (def: #export (record inferT) (-> Type (Operation Type)) @@ -247,13 +247,13 @@ (#.Named name unnamedT) (do ///.monad [unnamedT+ (recur depth unnamedT)] - (wrap unnamedT+)) + (in unnamedT+)) (^template [<tag>] [(<tag> env bodyT) (do ///.monad [bodyT+ (recur (inc depth) bodyT)] - (wrap (<tag> env bodyT+)))]) + (in (<tag> env bodyT+)))]) ([#.UnivQ] [#.ExQ]) @@ -266,36 +266,36 @@ (n.< boundary tag))) (case (list.nth tag cases) (#.Some caseT) - (///\wrap (if (n.= 0 depth) - (type.function (list caseT) currentT) - (let [replace' (replace (|> depth dec (n.* 2)) inferT)] - (type.function (list (replace' caseT)) - (replace' currentT))))) + (///\in (if (n.= 0 depth) + (type.function (list caseT) currentT) + (let [replace' (replace (|> depth dec (n.* 2)) inferT)] + (type.function (list (replace' caseT)) + (replace' currentT))))) #.None - (/.throw ..variant_tag_out_of_bounds [expected_size tag inferT])) + (/.except ..variant_tag_out_of_bounds [expected_size tag inferT])) (n.< expected_size actual_size) - (/.throw ..smaller_variant_than_expected [expected_size actual_size]) + (/.except ..smaller_variant_than_expected [expected_size actual_size]) (n.= boundary tag) (let [caseT (type.variant (list.drop boundary cases))] - (///\wrap (if (n.= 0 depth) - (type.function (list caseT) currentT) - (let [replace' (replace (|> depth dec (n.* 2)) inferT)] - (type.function (list (replace' caseT)) - (replace' currentT)))))) + (///\in (if (n.= 0 depth) + (type.function (list caseT) currentT) + (let [replace' (replace (|> depth dec (n.* 2)) inferT)] + (type.function (list (replace' caseT)) + (replace' currentT)))))) ## else - (/.throw ..variant_tag_out_of_bounds [expected_size tag inferT]))) + (/.except ..variant_tag_out_of_bounds [expected_size tag inferT]))) (#.Apply inputT funcT) - (case (type.apply (list inputT) funcT) + (case (type.applied (list inputT) funcT) (#.Some outputT) (variant tag expected_size outputT) #.None - (/.throw ..invalid_type_application inferT)) + (/.except ..invalid_type_application inferT)) _ - (/.throw ..not_a_variant_type inferT)))) + (/.except ..not_a_variant_type inferT)))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/module.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/module.lux index 94b289a08..1ae1152bd 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/module.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/module.lux @@ -93,7 +93,7 @@ []])) (#.Some old) - (/.throw' cannot_set_module_annotations_more_than_once [self_name old annotations]))))) + (/.except' cannot_set_module_annotations_more_than_once [self_name old annotations]))))) (def: #export (import module) (-> Text (Operation Any)) @@ -151,7 +151,7 @@ []]) (#.Some already_existing) - ((/.throw' ..cannot_define_more_than_once [[self_name name] already_existing]) state)))))) + ((/.except' ..cannot_define_more_than_once [[self_name name] already_existing]) state)))))) (def: #export (create hash name) (-> Nat Text (Operation Any)) @@ -168,8 +168,8 @@ [_ (create hash name) output (/.with_current_module name action) - module (///extension.lift (meta.find_module name))] - (wrap [module output]))) + module (///extension.lift (meta.module name))] + (in [module output]))) (template [<setter> <asker> <tag>] [(def: #export (<setter> module_name) @@ -186,11 +186,11 @@ (plist.put module_name (set@ #.module_state <tag> module)) state) []]) - ((/.throw' can_only_change_state_of_active_module [module_name <tag>]) + ((/.except' can_only_change_state_of_active_module [module_name <tag>]) state))) #.None - ((/.throw' unknown_module module_name) state))))) + ((/.except' unknown_module module_name) state))))) (def: #export (<asker> module_name) (-> Text (Operation Bit)) @@ -204,7 +204,7 @@ _ #0)]) #.None - ((/.throw' unknown_module module_name) state)))))] + ((/.except' unknown_module module_name) state)))))] [set_active active? #.Active] [set_compiled compiled? #.Compiled] @@ -221,7 +221,7 @@ (#try.Success [state (get@ <tag> module)]) #.None - ((/.throw' unknown_module module_name) state)))))] + ((/.except' unknown_module module_name) state)))))] [tags #.tags (List [Text [Nat (List Name) Bit Type]])] [types #.types (List [Text [(List Name) Bit Type]])] @@ -236,12 +236,12 @@ (function (_ tag) (case (plist.get tag bindings) #.None - (wrap []) + (in []) (#.Some _) - (/.throw ..cannot_declare_tag_twice [module_name tag]))) + (/.except ..cannot_declare_tag_twice [module_name tag]))) tags)] - (wrap []))) + (in []))) (def: #export (declare_tags tags exported? type) (-> (List Tag) Bit Type (Operation Any)) @@ -249,10 +249,10 @@ [self_name (///extension.lift meta.current_module_name) [type_module type_name] (case type (#.Named type_name _) - (wrap type_name) + (in type_name) _ - (/.throw ..cannot_declare_tags_for_unnamed_type [tags type])) + (/.except ..cannot_declare_tags_for_unnamed_type [tags type])) _ (ensure_undeclared_tags self_name tags) _ (///.assert cannot_declare_tags_for_foreign_type [tags type] (text\= self_name type_module))] @@ -272,4 +272,4 @@ state) []])) #.None - ((/.throw' unknown_module self_name) state)))))) + ((/.except' unknown_module self_name) state)))))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/primitive.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/primitive.lux index 27c4d98f4..4840dca2a 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/primitive.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/primitive.lux @@ -16,7 +16,7 @@ (-> <type> (Operation Analysis)) (do ///.monad [_ (//type.infer <type>)] - (wrap (#/.Primitive (<tag> value)))))] + (in (#/.Primitive (<tag> value)))))] [bit .Bit #/.Bit] [nat .Nat #/.Nat] @@ -30,4 +30,4 @@ (Operation Analysis) (do ///.monad [_ (//type.infer .Any)] - (wrap (#/.Primitive #/.Unit)))) + (in (#/.Primitive #/.Unit)))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/reference.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/reference.lux index 4e085a6b9..25f478f04 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/reference.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/reference.lux @@ -31,9 +31,9 @@ (def: (definition def_name) (-> Name (Operation Analysis)) - (with_expansions [<return> (wrap (|> def_name ///reference.constant #/.Reference))] + (with_expansions [<return> (in (|> def_name ///reference.constant #/.Reference))] (do {! ///.monad} - [constant (///extension.lift (meta.find_def def_name))] + [constant (///extension.lift (meta.definition def_name))] (case constant (#.Left real_def_name) (definition real_def_name) @@ -50,8 +50,8 @@ [imported! (///extension.lift (meta.imported_by? ::module current))] (if imported! <return> - (/.throw foreign_module_has_not_been_imported [current ::module]))) - (/.throw definition_has_not_been_exported def_name)))))))) + (/.except foreign_module_has_not_been_imported [current ::module]))) + (/.except definition_has_not_been_exported def_name)))))))) (def: (variable var_name) (-> Text (Operation (Maybe Analysis))) @@ -61,10 +61,10 @@ (#.Some [actualT ref]) (do ! [_ (//type.infer actualT)] - (wrap (#.Some (|> ref ///reference.variable #/.Reference)))) + (in (#.Some (|> ref ///reference.variable #/.Reference)))) #.None - (wrap #.None)))) + (in #.None)))) (def: #export (reference reference) (-> Name (Operation Analysis)) @@ -74,7 +74,7 @@ [?var (variable simple_name)] (case ?var (#.Some varA) - (wrap varA) + (in varA) #.None (do ! diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/scope.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/scope.lux index c0e598e06..ab202ed61 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/scope.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/scope.lux @@ -129,13 +129,13 @@ output])) _ - (exception.throw ..invalid_scope_alteration [])) + (exception.except ..invalid_scope_alteration [])) (#try.Failure error) (#try.Failure error))) _ - (exception.throw ..cannot_create_local_binding_without_a_scope [])) + (exception.except ..cannot_create_local_binding_without_a_scope [])) )) (template [<name> <val_type>] @@ -188,7 +188,7 @@ (#try.Success [state (get@ [#.locals #.counter] top)]) #.Nil - (exception.throw ..cannot_get_next_reference_when_there_is_no_scope []))))) + (exception.except ..cannot_get_next_reference_when_there_is_no_scope []))))) (def: (ref_to_variable ref) (-> Ref Variable) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/structure.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/structure.lux index ca42337d5..449ac9606 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/structure.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/structure.lux @@ -107,10 +107,10 @@ (do ! [valueA (//type.with_type variant_type (analyse archive valueC))] - (wrap (/.variant [lefts right? valueA]))) + (in (/.variant [lefts right? valueA]))) #.None - (/.throw //inference.variant_tag_out_of_bounds [(list.size flat) tag expectedT]))) + (/.except //inference.variant_tag_out_of_bounds [(list.size flat) tag expectedT]))) (#.Named name unnamedT) (//type.with_type unnamedT @@ -129,13 +129,13 @@ ## This is because there is no way of knowing how many ## cases the inferred sum type would have. _ - (/.throw ..cannot_infer_numeric_tag [expectedT tag valueC]))) + (/.except ..cannot_infer_numeric_tag [expectedT tag valueC]))) (^template [<tag> <instancer>] [(<tag> _) (do ! [[instance_id instanceT] (//type.with_env <instancer>)] - (//type.with_type (maybe.assume (type.apply (list instanceT) expectedT)) + (//type.with_type (maybe.assume (type.applied (list instanceT) expectedT)) (recur valueC)))]) ([#.UnivQ check.existential] [#.ExQ check.var]) @@ -151,19 +151,19 @@ (recur valueC)) _ - (/.throw ..invalid_variant_type [expectedT tag valueC]))) + (/.except ..invalid_variant_type [expectedT tag valueC]))) _ - (case (type.apply (list inputT) funT) + (case (type.applied (list inputT) funT) (#.Some outputT) (//type.with_type outputT (recur valueC)) #.None - (/.throw ..not_a_quantified_type funT))) + (/.except ..not_a_quantified_type funT))) _ - (/.throw ..invalid_variant_type [expectedT tag valueC]))))))) + (/.except ..invalid_variant_type [expectedT tag valueC]))))))) (def: (typed_product archive analyse members) (-> Archive Phase (List Code) (Operation Analysis)) @@ -186,11 +186,11 @@ [memberA (//type.with_type memberT (analyse archive memberC)) memberA+ (recur membersT+' membersC+')] - (wrap (#.Cons memberA memberA+))) + (in (#.Cons memberA memberA+))) _ - (/.throw ..cannot_analyse_tuple [expectedT members]))))] - (wrap (/.tuple membersA+)))) + (/.except ..cannot_analyse_tuple [expectedT members]))))] + (in (/.tuple membersA+)))) (def: #export (product archive analyse membersC) (-> Archive Phase (List Code) (Operation Analysis)) @@ -222,13 +222,13 @@ _ (//type.with_env (check.check expectedT (type.tuple (list\map product.left membersTA))))] - (wrap (/.tuple (list\map product.right membersTA)))))) + (in (/.tuple (list\map product.right membersTA)))))) (^template [<tag> <instancer>] [(<tag> _) (do ! [[instance_id instanceT] (//type.with_env <instancer>)] - (//type.with_type (maybe.assume (type.apply (list instanceT) expectedT)) + (//type.with_type (maybe.assume (type.applied (list instanceT) expectedT)) (product archive analyse membersC)))]) ([#.UnivQ check.existential] [#.ExQ check.var]) @@ -244,19 +244,19 @@ (product archive analyse membersC)) _ - (/.throw ..invalid_tuple_type [expectedT membersC]))) + (/.except ..invalid_tuple_type [expectedT membersC]))) _ - (case (type.apply (list inputT) funT) + (case (type.applied (list inputT) funT) (#.Some outputT) (//type.with_type outputT (product archive analyse membersC)) #.None - (/.throw ..not_a_quantified_type funT))) + (/.except ..not_a_quantified_type funT))) _ - (/.throw ..invalid_tuple_type [expectedT membersC]) + (/.except ..invalid_tuple_type [expectedT membersC]) )))) (def: #export (tagged_sum analyse tag archive valueC) @@ -272,7 +272,7 @@ (do ! [inferenceT (//inference.variant idx case_size variantT) [inferredT valueA+] (//inference.general archive analyse inferenceT (list valueC))] - (wrap (/.variant [lefts right? (|> valueA+ list.head maybe.assume)]))) + (in (/.variant [lefts right? (|> valueA+ list.head maybe.assume)]))) _ (..sum analyse lefts right? archive valueC)))) @@ -289,10 +289,10 @@ [_ (#.Tag key)] (do ///.monad [key (///extension.lift (meta.normal key))] - (wrap [key val])) + (in [key val])) _ - (/.throw ..record_keys_must_be_tags [key record]))) + (/.except ..record_keys_must_be_tags [key record]))) record)) ## Lux already possesses the means to analyse tuples, so @@ -303,7 +303,7 @@ (case record ## empty_record = empty_tuple = unit = [] #.Nil - (\ ///.monad wrap [(list) Any]) + (\ ///.monad in [(list) Any]) (#.Cons [head_k head_v] _) (do {! ///.monad} @@ -312,8 +312,8 @@ #let [size_record (list.size record) size_ts (list.size tag_set)] _ (if (n.= size_ts size_record) - (wrap []) - (/.throw ..record_size_mismatch [size_ts size_record recordT record])) + (in []) + (/.except ..record_size_mismatch [size_ts size_record recordT record])) #let [tuple_range (list.indices size_ts) tag->idx (dictionary.of_list name.hash (list.zipped/2 tag_set tuple_range))] idx->val (monad.fold ! @@ -323,17 +323,17 @@ (case (dictionary.get key tag->idx) (#.Some idx) (if (dictionary.key? idx->val idx) - (/.throw ..cannot_repeat_tag [key record]) - (wrap (dictionary.put idx val idx->val))) + (/.except ..cannot_repeat_tag [key record]) + (in (dictionary.put idx val idx->val))) #.None - (/.throw ..tag_does_not_belong_to_record [key recordT])))) + (/.except ..tag_does_not_belong_to_record [key recordT])))) (: (Dictionary Nat Code) (dictionary.new n.hash)) record) #let [ordered_tuple (list\map (function (_ idx) (maybe.assume (dictionary.get idx idx->val))) tuple_range)]] - (wrap [ordered_tuple recordT])) + (in [ordered_tuple recordT])) )) (def: #export (record archive analyse members) @@ -355,7 +355,7 @@ (do ! [inferenceT (//inference.record recordT) [inferredT membersA] (//inference.general archive analyse inferenceT membersC)] - (wrap (/.tuple membersA))) + (in (/.tuple membersA))) _ (..product archive analyse membersC))))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/type.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/type.lux index c9227aa31..f530c80ae 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/type.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/type.lux @@ -53,4 +53,4 @@ action) knownT (..with_env (check.clean varT))] - (wrap [knownT output]))) + (in [knownT output]))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/directive.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/directive.lux index 882ac3a6e..ef7cffba4 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/directive.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/directive.lux @@ -54,17 +54,17 @@ (case macroA (^ (///analysis.constant macro_name)) (do ! - [?macro (//extension.lift (meta.find_macro macro_name)) + [?macro (//extension.lift (meta.macro macro_name)) macro (case ?macro (#.Some macro) - (wrap macro) + (in macro) #.None - (//.throw ..macro_was_not_found macro_name))] + (//.except ..macro_was_not_found macro_name))] (//extension.lift (///analysis/macro.expand expander macro_name macro inputs))) _ - (//.throw ..invalid_macro_call code))))] + (//.except ..invalid_macro_call code))))] (case expansion (^ (list& <lux_def_module> referrals)) (|> (recur archive <lux_def_module>) @@ -76,4 +76,4 @@ (\ ! map (list\fold /.merge_requirements /.no_requirements))))) _ - (//.throw ..not_a_directive code)))))) + (//.except ..not_a_directive code)))))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension.lux index fd30c45d2..d0f8db7c5 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension.lux @@ -96,7 +96,7 @@ []]) _ - (exception.throw ..cannot_overwrite name)))) + (exception.except ..cannot_overwrite name)))) (def: #export (with extender extensions) (All [s i o] @@ -118,7 +118,7 @@ stateE) #.None - (exception.throw ..unknown [name bundle])))) + (exception.except ..unknown [name bundle])))) (def: #export (localized get set transform) (All [s s' i o v] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/js.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/js.lux index 5660a2a85..4f185f810 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/js.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/js.lux @@ -38,7 +38,7 @@ (phase archive lengthC)) [var_id varT] (analysis/type.with_env check.var) _ (analysis/type.infer (type (Array varT)))] - (wrap (#analysis.Extension extension (list lengthA)))))])) + (in (#analysis.Extension extension (list lengthA)))))])) (def: array::length Handler @@ -50,7 +50,7 @@ arrayA (analysis/type.with_type (type (Array varT)) (phase archive arrayC)) _ (analysis/type.infer Nat)] - (wrap (#analysis.Extension extension (list arrayA)))))])) + (in (#analysis.Extension extension (list arrayA)))))])) (def: array::read Handler @@ -64,7 +64,7 @@ arrayA (analysis/type.with_type (type (Array varT)) (phase archive arrayC)) _ (analysis/type.infer varT)] - (wrap (#analysis.Extension extension (list indexA arrayA)))))])) + (in (#analysis.Extension extension (list indexA arrayA)))))])) (def: array::write Handler @@ -80,7 +80,7 @@ arrayA (analysis/type.with_type (type (Array varT)) (phase archive arrayC)) _ (analysis/type.infer (type (Array varT)))] - (wrap (#analysis.Extension extension (list indexA valueA arrayA)))))])) + (in (#analysis.Extension extension (list indexA valueA arrayA)))))])) (def: array::delete Handler @@ -94,7 +94,7 @@ arrayA (analysis/type.with_type (type (Array varT)) (phase archive arrayC)) _ (analysis/type.infer (type (Array varT)))] - (wrap (#analysis.Extension extension (list indexA arrayA)))))])) + (in (#analysis.Extension extension (list indexA arrayA)))))])) (def: bundle::array Bundle @@ -117,7 +117,7 @@ (phase archive constructorC)) inputsA (monad.map ! (|>> (phase archive) (analysis/type.with_type Any)) inputsC) _ (analysis/type.infer .Any)] - (wrap (#analysis.Extension extension (list& constructorA inputsA)))))])) + (in (#analysis.Extension extension (list& constructorA inputsA)))))])) (def: object::get Handler @@ -128,8 +128,8 @@ [objectA (analysis/type.with_type Any (phase archive objectC)) _ (analysis/type.infer .Any)] - (wrap (#analysis.Extension extension (list (analysis.text fieldC) - objectA)))))])) + (in (#analysis.Extension extension (list (analysis.text fieldC) + objectA)))))])) (def: object::do Handler @@ -141,9 +141,9 @@ (phase archive objectC)) inputsA (monad.map ! (|>> (phase archive) (analysis/type.with_type Any)) inputsC) _ (analysis/type.infer .Any)] - (wrap (#analysis.Extension extension (list& (analysis.text methodC) - objectA - inputsA)))))])) + (in (#analysis.Extension extension (list& (analysis.text methodC) + objectA + inputsA)))))])) (def: bundle::object Bundle @@ -165,7 +165,7 @@ (function (_ extension phase archive name) (do phase.monad [_ (analysis/type.infer Any)] - (wrap (#analysis.Extension extension (list (analysis.text name))))))])) + (in (#analysis.Extension extension (list (analysis.text name))))))])) (def: js::apply Handler @@ -177,7 +177,7 @@ (phase archive abstractionC)) inputsA (monad.map ! (|>> (phase archive) (analysis/type.with_type Any)) inputsC) _ (analysis/type.infer Any)] - (wrap (#analysis.Extension extension (list& abstractionA inputsA)))))])) + (in (#analysis.Extension extension (list& abstractionA inputsA)))))])) (def: js::type_of Handler @@ -188,7 +188,7 @@ [objectA (analysis/type.with_type Any (phase archive objectC)) _ (analysis/type.infer .Text)] - (wrap (#analysis.Extension extension (list objectA)))))])) + (in (#analysis.Extension extension (list objectA)))))])) (def: js::function Handler @@ -201,8 +201,8 @@ (phase archive abstractionC)) _ (analysis/type.infer (for {@.js ffi.Function} Any))] - (wrap (#analysis.Extension extension (list (analysis.nat arity) - abstractionA)))))])) + (in (#analysis.Extension extension (list (analysis.nat arity) + abstractionA)))))])) (def: #export bundle Bundle diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux index bd49944a1..6ff584f36 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux @@ -352,12 +352,12 @@ (jvm_type anonymousT) (#.Apply inputT abstractionT) - (case (type.apply (list inputT) abstractionT) + (case (type.applied (list inputT) abstractionT) (#.Some outputT) (jvm_type outputT) #.None - (/////analysis.throw ..non_jvm_type luxT)) + (/////analysis.except ..non_jvm_type luxT)) (^ (#.Primitive (static array.type_name) (list elemT))) (phase\map jvm.array (jvm_type elemT)) @@ -367,10 +367,10 @@ (#.Some [_ primitive_type]) (case parametersT #.Nil - (phase\wrap primitive_type) + (phase\in primitive_type) _ - (/////analysis.throw ..primitives_cannot_have_type_parameters class)) + (/////analysis.except ..primitives_cannot_have_type_parameters class)) #.None (do {! phase.monad} @@ -381,18 +381,18 @@ [parameterJT (jvm_type parameterT)] (case (jvm_parser.parameter? parameterJT) (#.Some parameterJT) - (wrap parameterJT) + (in parameterJT) #.None - (/////analysis.throw ..non_parameter parameterT)))) + (/////analysis.except ..non_parameter parameterT)))) parametersT))] - (wrap (jvm.class class parametersJT)))) + (in (jvm.class class parametersJT)))) (#.Ex _) - (phase\wrap (jvm.class ..object_class (list))) + (phase\in (jvm.class ..object_class (list))) _ - (/////analysis.throw ..non_jvm_type luxT))) + (/////analysis.except ..non_jvm_type luxT))) (def: (jvm_array_type objectT) (-> .Type (Operation (Type Array))) @@ -414,10 +414,10 @@ ..reflection) (list)) (analyse archive arrayC))] - (wrap (#/////analysis.Extension extension_name (list arrayA)))) + (in (#/////analysis.Extension extension_name (list arrayA)))) _ - (/////analysis.throw ///.incorrect_arity [extension_name 1 (list.size args)])))) + (/////analysis.except ///.incorrect_arity [extension_name 1 (list.size args)])))) (def: array::length::object Handler @@ -431,11 +431,11 @@ (analyse archive arrayC)) varT (typeA.with_env (check.clean varT)) arrayJT (jvm_array_type (.type (array.Array varT)))] - (wrap (#/////analysis.Extension extension_name (list (/////analysis.text (..signature arrayJT)) - arrayA)))) + (in (#/////analysis.Extension extension_name (list (/////analysis.text (..signature arrayJT)) + arrayA)))) _ - (/////analysis.throw ///.incorrect_arity [extension_name 1 (list.size args)])))) + (/////analysis.except ///.incorrect_arity [extension_name 1 (list.size args)])))) (def: (new_primitive_array_handler primitive_type) (-> (Type Primitive) Handler) @@ -447,10 +447,10 @@ (analyse archive lengthC)) _ (typeA.infer (#.Primitive (|> (jvm.array primitive_type) ..reflection) (list)))] - (wrap (#/////analysis.Extension extension_name (list lengthA)))) + (in (#/////analysis.Extension extension_name (list lengthA)))) _ - (/////analysis.throw ///.incorrect_arity [extension_name 1 (list.size args)])))) + (/////analysis.except ///.incorrect_arity [extension_name 1 (list.size args)])))) (def: array::new::object Handler @@ -464,22 +464,22 @@ expectedJT (jvm_array_type expectedT) elementJT (case (jvm_parser.array? expectedJT) (#.Some elementJT) - (wrap elementJT) + (in elementJT) #.None - (/////analysis.throw ..non_array expectedT))] - (wrap (#/////analysis.Extension extension_name (list (/////analysis.text (..signature elementJT)) - lengthA)))) + (/////analysis.except ..non_array expectedT))] + (in (#/////analysis.Extension extension_name (list (/////analysis.text (..signature elementJT)) + lengthA)))) _ - (/////analysis.throw ///.incorrect_arity [extension_name 1 (list.size args)])))) + (/////analysis.except ///.incorrect_arity [extension_name 1 (list.size args)])))) (def: (check_parameter objectT) (-> .Type (Operation (Type Parameter))) (case objectT (^ (#.Primitive (static array.type_name) (list elementT))) - (/////analysis.throw ..non_parameter objectT) + (/////analysis.except ..non_parameter objectT) (#.Primitive name parameters) (`` (cond (or (~~ (template [<type>] @@ -494,17 +494,17 @@ [jvm.double] [jvm.char])) (text.starts_with? descriptor.array_prefix name)) - (/////analysis.throw ..non_parameter objectT) + (/////analysis.except ..non_parameter objectT) ## else - (phase\wrap (jvm.class name (list))))) + (phase\in (jvm.class name (list))))) (#.Named name anonymous) (check_parameter anonymous) (^template [<tag>] [(<tag> id) - (phase\wrap (jvm.class ..object_class (list)))]) + (phase\in (jvm.class ..object_class (list)))]) ([#.Var] [#.Ex]) @@ -515,15 +515,15 @@ [#.ExQ]) (#.Apply inputT abstractionT) - (case (type.apply (list inputT) abstractionT) + (case (type.applied (list inputT) abstractionT) (#.Some outputT) (check_parameter outputT) #.None - (/////analysis.throw ..non_parameter objectT)) + (/////analysis.except ..non_parameter objectT)) _ - (/////analysis.throw ..non_parameter objectT))) + (/////analysis.except ..non_parameter objectT))) (def: (check_jvm objectT) (-> .Type (Operation (Type Value))) @@ -531,7 +531,7 @@ (#.Primitive name #.Nil) (`` (cond (~~ (template [<type>] [(text\= (..reflection <type>) name) - (phase\wrap <type>)] + (phase\in <type>)] [jvm.boolean] [jvm.byte] @@ -544,7 +544,7 @@ (~~ (template [<type>] [(text\= (..reflection (jvm.array <type>)) name) - (phase\wrap (jvm.array <type>))] + (phase\in (jvm.array <type>))] [jvm.boolean] [jvm.byte] @@ -561,7 +561,7 @@ (check_jvm (#.Primitive unprefixed (list))))) ## else - (phase\wrap (jvm.class name (list))))) + (phase\in (jvm.class name (list))))) (^ (#.Primitive (static array.type_name) (list elementT))) @@ -572,7 +572,7 @@ (#.Primitive name parameters) (do {! phase.monad} [parameters (monad.map ! check_parameter parameters)] - (phase\wrap (jvm.class name parameters))) + (phase\in (jvm.class name parameters))) (#.Named name anonymous) (check_jvm anonymous) @@ -584,12 +584,12 @@ [#.ExQ]) (#.Apply inputT abstractionT) - (case (type.apply (list inputT) abstractionT) + (case (type.applied (list inputT) abstractionT) (#.Some outputT) (check_jvm outputT) #.None - (/////analysis.throw ..non_object objectT)) + (/////analysis.except ..non_object objectT)) _ (check_parameter objectT))) @@ -599,13 +599,13 @@ (do {! phase.monad} [name (\ ! map ..reflection (check_jvm objectT))] (if (dictionary.key? ..boxes name) - (/////analysis.throw ..primitives_are_not_objects [name]) - (phase\wrap name)))) + (/////analysis.except ..primitives_are_not_objects [name]) + (phase\in name)))) (def: (check_return type) (-> .Type (Operation (Type Return))) (if (is? .Any type) - (phase\wrap jvm.void) + (phase\in jvm.void) (check_jvm type))) (def: (read_primitive_array_handler lux_type jvm_type) @@ -620,10 +620,10 @@ arrayA (typeA.with_type (#.Primitive (|> (jvm.array jvm_type) ..reflection) (list)) (analyse archive arrayC))] - (wrap (#/////analysis.Extension extension_name (list idxA arrayA)))) + (in (#/////analysis.Extension extension_name (list idxA arrayA)))) _ - (/////analysis.throw ///.incorrect_arity [extension_name 2 (list.size args)])))) + (/////analysis.except ///.incorrect_arity [extension_name 2 (list.size args)])))) (def: array::read::object Handler @@ -640,12 +640,12 @@ arrayJT (jvm_array_type (.type (array.Array varT))) idxA (typeA.with_type ..int (analyse archive idxC))] - (wrap (#/////analysis.Extension extension_name (list (/////analysis.text (..signature arrayJT)) - idxA - arrayA)))) + (in (#/////analysis.Extension extension_name (list (/////analysis.text (..signature arrayJT)) + idxA + arrayA)))) _ - (/////analysis.throw ///.incorrect_arity [extension_name 2 (list.size args)])))) + (/////analysis.except ///.incorrect_arity [extension_name 2 (list.size args)])))) (def: (write_primitive_array_handler lux_type jvm_type) (-> .Type (Type Primitive) Handler) @@ -662,12 +662,12 @@ (analyse archive valueC)) arrayA (typeA.with_type array_type (analyse archive arrayC))] - (wrap (#/////analysis.Extension extension_name (list idxA - valueA - arrayA)))) + (in (#/////analysis.Extension extension_name (list idxA + valueA + arrayA)))) _ - (/////analysis.throw ///.incorrect_arity [extension_name 3 (list.size args)]))))) + (/////analysis.except ///.incorrect_arity [extension_name 3 (list.size args)]))))) (def: array::write::object Handler @@ -686,13 +686,13 @@ (analyse archive idxC)) valueA (typeA.with_type varT (analyse archive valueC))] - (wrap (#/////analysis.Extension extension_name (list (/////analysis.text (..signature arrayJT)) - idxA - valueA - arrayA)))) + (in (#/////analysis.Extension extension_name (list (/////analysis.text (..signature arrayJT)) + idxA + valueA + arrayA)))) _ - (/////analysis.throw ///.incorrect_arity [extension_name 3 (list.size args)])))) + (/////analysis.except ///.incorrect_arity [extension_name 3 (list.size args)])))) (def: bundle::array Bundle @@ -752,10 +752,10 @@ (do phase.monad [expectedT (///.lift meta.expected_type) _ (check_object expectedT)] - (wrap (#/////analysis.Extension extension_name (list)))) + (in (#/////analysis.Extension extension_name (list)))) _ - (/////analysis.throw ///.incorrect_arity [extension_name 0 (list.size args)])))) + (/////analysis.except ///.incorrect_arity [extension_name 0 (list.size args)])))) (def: object::null? Handler @@ -767,10 +767,10 @@ [objectT objectA] (typeA.with_inference (analyse archive objectC)) _ (check_object objectT)] - (wrap (#/////analysis.Extension extension_name (list objectA)))) + (in (#/////analysis.Extension extension_name (list objectA)))) _ - (/////analysis.throw ///.incorrect_arity [extension_name 1 (list.size args)])))) + (/////analysis.except ///.incorrect_arity [extension_name 1 (list.size args)])))) (def: object::synchronized Handler @@ -782,10 +782,10 @@ (analyse archive monitorC)) _ (check_object monitorT) exprA (analyse archive exprC)] - (wrap (#/////analysis.Extension extension_name (list monitorA exprA)))) + (in (#/////analysis.Extension extension_name (list monitorA exprA)))) _ - (/////analysis.throw ///.incorrect_arity [extension_name 2 (list.size args)])))) + (/////analysis.except ///.incorrect_arity [extension_name 2 (list.size args)])))) (def: (object::throw class_loader) (-> java/lang/ClassLoader Handler) @@ -800,12 +800,12 @@ ? (phase.lift (reflection!.sub? class_loader "java.lang.Throwable" exception_class)) _ (: (Operation Any) (if ? - (wrap []) - (/////analysis.throw non_throwable exception_class)))] - (wrap (#/////analysis.Extension extension_name (list exceptionA)))) + (in []) + (/////analysis.except non_throwable exception_class)))] + (in (#/////analysis.Extension extension_name (list exceptionA)))) _ - (/////analysis.throw ///.incorrect_arity [extension_name 1 (list.size args)])))) + (/////analysis.except ///.incorrect_arity [extension_name 1 (list.size args)])))) (def: (object::class class_loader) (-> java/lang/ClassLoader Handler) @@ -818,13 +818,13 @@ [_ (..ensure_fresh_class! class_loader class) _ (typeA.infer (#.Primitive "java.lang.Class" (list (#.Primitive class (list))))) _ (phase.lift (reflection!.load class_loader class))] - (wrap (#/////analysis.Extension extension_name (list (/////analysis.text class))))) + (in (#/////analysis.Extension extension_name (list (/////analysis.text class))))) _ - (/////analysis.throw ///.invalid_syntax [extension_name %.code args])) + (/////analysis.except ///.invalid_syntax [extension_name %.code args])) _ - (/////analysis.throw ///.incorrect_arity [extension_name 1 (list.size args)])))) + (/////analysis.except ///.incorrect_arity [extension_name 1 (list.size args)])))) (def: (object::instance? class_loader) (-> java/lang/ClassLoader Handler) @@ -839,8 +839,8 @@ object_class (check_object objectT) ? (phase.lift (reflection!.sub? class_loader object_class sub_class))] (if ? - (wrap (#/////analysis.Extension extension_name (list (/////analysis.text sub_class) objectA))) - (/////analysis.throw cannot_possibly_be_an_instance (format sub_class " !<= " object_class)))))])) + (in (#/////analysis.Extension extension_name (list (/////analysis.text sub_class) objectA))) + (/////analysis.except cannot_possibly_be_an_instance (format sub_class " !<= " object_class)))))])) (template [<name> <category> <parser>] [(def: #export (<name> mapping typeJ) @@ -871,7 +871,7 @@ #let [super_name (|> superJT ..reflection)] super_class (phase.lift (reflection!.load class_loader super_name)) superT (reflection_type mapping superJT)] - (wrap [[super_name superT] (java/lang/Class::isAssignableFrom super_class to_class)]))) + (in [[super_name superT] (java/lang/Class::isAssignableFrom super_class to_class)]))) (case (java/lang/Class::getGenericSuperclass from_class) (#.Some super) (list& super (array.to_list (java/lang/Class::getGenericInterfaces from_class))) @@ -891,12 +891,12 @@ (do {! phase.monad} [super_name (\ ! map ..reflection (check_jvm superT)) super_class (phase.lift (reflection!.load class_loader super_name))] - (wrap [[super_name superT] - (java/lang/Class::isAssignableFrom super_class to_class)]))) + (in [[super_name superT] + (java/lang/Class::isAssignableFrom super_class to_class)]))) (list& super_classT super_interfacesT+)) _ - (/////analysis.throw ..cannot_cast [fromT toT fromC]))) + (/////analysis.except ..cannot_cast [fromT toT fromC]))) (def: (object::cast class_loader) (-> java/lang/ClassLoader Handler) @@ -917,7 +917,7 @@ (text\= =primitive to_name))) (and (text\= <object> from_name) (text\= =primitive to_name)))) - (wrap true)] + (in true)] [reflection.boolean box.boolean] [reflection.byte box.byte] @@ -936,14 +936,14 @@ (not (dictionary.key? ..boxes to_name))) to_class (phase.lift (reflection!.load class_loader to_name)) _ (if (text\= ..inheritance_relationship_type_name from_name) - (wrap []) + (in []) (do ! [from_class (phase.lift (reflection!.load class_loader from_name))] (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) - (wrap true) + (in true) (do ! [candidate_parents (: (Operation (List [[Text .Type] Bit])) (if (text\= ..inheritance_relationship_type_name current_name) @@ -956,15 +956,15 @@ (recur [next_name nextT]) #.Nil - (wrap false)))))))))] + (in false)))))))))] (if can_cast? - (wrap (#/////analysis.Extension extension_name (list (/////analysis.text from_name) - (/////analysis.text to_name) - fromA))) - (/////analysis.throw ..cannot_cast [fromT toT fromC]))) + (in (#/////analysis.Extension extension_name (list (/////analysis.text from_name) + (/////analysis.text to_name) + fromA))) + (/////analysis.except ..cannot_cast [fromT toT fromC]))) _ - (/////analysis.throw ///.invalid_syntax [extension_name %.code args])))) + (/////analysis.except ///.invalid_syntax [extension_name %.code args])))) (def: (bundle::object class_loader) (-> java/lang/ClassLoader Bundle) @@ -994,10 +994,10 @@ (not deprecated?)) fieldT (reflection_type luxT.fresh fieldJT) _ (typeA.infer fieldT)] - (wrap (<| (#/////analysis.Extension extension_name) - (list (/////analysis.text class) - (/////analysis.text field) - (/////analysis.text (|> fieldJT ..reflection)))))))])) + (in (<| (#/////analysis.Extension extension_name) + (list (/////analysis.text class) + (/////analysis.text field) + (/////analysis.text (|> fieldJT ..reflection)))))))])) (def: (put::static class_loader) (-> java/lang/ClassLoader Handler) @@ -1018,10 +1018,10 @@ fieldT (reflection_type luxT.fresh fieldJT) valueA (typeA.with_type fieldT (analyse archive valueC))] - (wrap (<| (#/////analysis.Extension extension_name) - (list (/////analysis.text class) - (/////analysis.text field) - valueA)))))])) + (in (<| (#/////analysis.Extension extension_name) + (list (/////analysis.text class) + (/////analysis.text field) + valueA)))))])) (def: (get::virtual class_loader) (-> java/lang/ClassLoader Handler) @@ -1037,16 +1037,16 @@ [class (reflection!.load class_loader class) [final? deprecated? fieldJT] (reflection!.virtual_field field class) mapping (reflection!.correspond class objectT)] - (wrap [deprecated? mapping fieldJT]))) + (in [deprecated? mapping fieldJT]))) _ (phase.assert ..deprecated_field [class field] (not deprecated?)) fieldT (reflection_type mapping fieldJT) _ (typeA.infer fieldT)] - (wrap (<| (#/////analysis.Extension extension_name) - (list (/////analysis.text class) - (/////analysis.text field) - (/////analysis.text (..reflection fieldJT)) - objectA)))))])) + (in (<| (#/////analysis.Extension extension_name) + (list (/////analysis.text class) + (/////analysis.text field) + (/////analysis.text (..reflection fieldJT)) + objectA)))))])) (def: (put::virtual class_loader) (-> java/lang/ClassLoader Handler) @@ -1063,7 +1063,7 @@ [class (reflection!.load class_loader class) [final? deprecated? fieldJT] (reflection!.virtual_field field class) mapping (reflection!.correspond class objectT)] - (wrap [final? deprecated? mapping fieldJT]))) + (in [final? deprecated? mapping fieldJT]))) _ (phase.assert ..deprecated_field [class field] (not deprecated?)) _ (phase.assert ..cannot_set_a_final_field [class field] @@ -1071,12 +1071,12 @@ fieldT (reflection_type mapping fieldJT) valueA (typeA.with_type fieldT (analyse archive valueC))] - (wrap (<| (#/////analysis.Extension extension_name) - (list (/////analysis.text class) - (/////analysis.text field) - (/////analysis.text (..reflection fieldJT)) - valueA - objectA)))))])) + (in (<| (#/////analysis.Extension extension_name) + (list (/////analysis.text class) + (/////analysis.text field) + (/////analysis.text (..reflection fieldJT)) + valueA + objectA)))))])) (type: Method_Style #Static @@ -1124,12 +1124,12 @@ actualJC))))) true (list.zipped/2 parameters inputsJT)))]] - (wrap (and correct_class? - correct_method? - static_matches? - special_matches? - arity_matches? - inputs_match?)))) + (in (and correct_class? + correct_method? + static_matches? + special_matches? + arity_matches? + inputs_match?)))) (def: (check_constructor aliasing class inputsJT constructor) (-> Aliasing (java/lang/Class java/lang/Object) (List (Type Value)) (java/lang/reflect/Constructor java/lang/Object) (Operation Bit)) @@ -1138,22 +1138,22 @@ array.to_list (monad.map try.monad reflection!.type) phase.lift)] - (wrap (and (java/lang/Object::equals class (java/lang/reflect/Constructor::getDeclaringClass constructor)) - (n.= (list.size inputsJT) (list.size parameters)) - (list\fold (function (_ [expectedJC actualJC] prev) - (and prev - (jvm\= expectedJC (: (Type Value) - (case (jvm_parser.var? actualJC) - (#.Some name) - (|> aliasing - (dictionary.get name) - (maybe.default name) - jvm.var) - - #.None - actualJC))))) - true - (list.zipped/2 parameters inputsJT)))))) + (in (and (java/lang/Object::equals class (java/lang/reflect/Constructor::getDeclaringClass constructor)) + (n.= (list.size inputsJT) (list.size parameters)) + (list\fold (function (_ [expectedJC actualJC] prev) + (and prev + (jvm\= expectedJC (: (Type Value) + (case (jvm_parser.var? actualJC) + (#.Some name) + (|> aliasing + (dictionary.get name) + (maybe.default name) + jvm.var) + + #.None + actualJC))))) + true + (list.zipped/2 parameters inputsJT)))))) (def: idx_to_parameter (-> Nat .Type) @@ -1214,9 +1214,9 @@ (list& (#.Primitive (java/lang/Class::getName owner) owner_tvarsT) inputsT))) outputT)]] - (wrap [methodT - (reflection!.deprecated? (java/lang/reflect/Method::getDeclaredAnnotations method)) - exceptionsT])))) + (in [methodT + (reflection!.deprecated? (java/lang/reflect/Method::getDeclaredAnnotations method)) + exceptionsT])))) (def: (constructor_signature constructor) (-> (java/lang/reflect/Constructor java/lang/Object) (Operation Method_Signature)) @@ -1243,9 +1243,9 @@ constructorT (<| (type.univ_q (dictionary.size mapping)) (type.function inputsT) objectT)]] - (wrap [constructorT - (reflection!.deprecated? (java/lang/reflect/Constructor::getDeclaredAnnotations constructor)) - exceptionsT])))) + (in [constructorT + (reflection!.deprecated? (java/lang/reflect/Constructor::getDeclaredAnnotations constructor)) + exceptionsT])))) (type: Evaluation (#Pass Method_Signature) @@ -1304,13 +1304,13 @@ (method_signature method_style method)))))))] (case (list.all pass! candidates) (#.Cons method #.Nil) - (wrap method) + (in method) #.Nil - (/////analysis.throw ..no_candidates [class_name method_name inputsJT (list.all hint! candidates)]) + (/////analysis.except ..no_candidates [class_name method_name inputsJT (list.all hint! candidates)]) candidates - (/////analysis.throw ..too_many_candidates [class_name method_name inputsJT candidates])))) + (/////analysis.except ..too_many_candidates [class_name method_name inputsJT candidates])))) (def: constructor_method "<init>") @@ -1334,18 +1334,18 @@ (constructor_signature constructor))))))] (case (list.all pass! candidates) (#.Cons constructor #.Nil) - (wrap constructor) + (in constructor) #.Nil - (/////analysis.throw ..no_candidates [class_name ..constructor_method inputsJT (list.all hint! candidates)]) + (/////analysis.except ..no_candidates [class_name ..constructor_method inputsJT (list.all hint! candidates)]) candidates - (/////analysis.throw ..too_many_candidates [class_name ..constructor_method inputsJT candidates])))) + (/////analysis.except ..too_many_candidates [class_name ..constructor_method inputsJT candidates])))) (template [<name> <category> <parser>] [(def: #export <name> (Parser (Type <category>)) - (<text>.embed <parser> <code>.text))] + (<text>.then <parser> <code>.text))] [var Var jvm_parser.var] [class Class jvm_parser.class] @@ -1380,10 +1380,10 @@ (not deprecated?)) [outputT argsA] (inferenceA.general archive analyse methodT (list\map product.right argsTC)) outputJT (check_return outputT)] - (wrap (#/////analysis.Extension extension_name (list& (/////analysis.text (..signature (jvm.class class (list)))) - (/////analysis.text method) - (/////analysis.text (..signature outputJT)) - (decorate_inputs argsT argsA))))))])) + (in (#/////analysis.Extension extension_name (list& (/////analysis.text (..signature (jvm.class class (list)))) + (/////analysis.text method) + (/////analysis.text (..signature outputJT)) + (decorate_inputs argsT argsA))))))])) (def: (invoke::virtual class_loader) (-> java/lang/ClassLoader Handler) @@ -1404,11 +1404,11 @@ _ (undefined))] outputJT (check_return outputT)] - (wrap (#/////analysis.Extension extension_name (list& (/////analysis.text (..signature (jvm.class class (list)))) - (/////analysis.text method) - (/////analysis.text (..signature outputJT)) - objectA - (decorate_inputs argsT argsA))))))])) + (in (#/////analysis.Extension extension_name (list& (/////analysis.text (..signature (jvm.class class (list)))) + (/////analysis.text method) + (/////analysis.text (..signature outputJT)) + objectA + (decorate_inputs argsT argsA))))))])) (def: (invoke::special class_loader) (-> java/lang/ClassLoader Handler) @@ -1423,10 +1423,10 @@ (not deprecated?)) [outputT argsA] (inferenceA.general archive analyse methodT (list& objectC (list\map product.right argsTC))) outputJT (check_return outputT)] - (wrap (#/////analysis.Extension extension_name (list& (/////analysis.text (..signature (jvm.class class (list)))) - (/////analysis.text method) - (/////analysis.text (..signature outputJT)) - (decorate_inputs argsT argsA))))))])) + (in (#/////analysis.Extension extension_name (list& (/////analysis.text (..signature (jvm.class class (list)))) + (/////analysis.text method) + (/////analysis.text (..signature outputJT)) + (decorate_inputs argsT argsA))))))])) (def: (invoke::interface class_loader) (-> java/lang/ClassLoader Handler) @@ -1450,12 +1450,12 @@ _ (undefined))] outputJT (check_return outputT)] - (wrap (#/////analysis.Extension extension_name - (list& (/////analysis.text (..signature (jvm.class class_name (list)))) - (/////analysis.text method) - (/////analysis.text (..signature outputJT)) - objectA - (decorate_inputs argsT argsA))))))])) + (in (#/////analysis.Extension extension_name + (list& (/////analysis.text (..signature (jvm.class class_name (list)))) + (/////analysis.text method) + (/////analysis.text (..signature outputJT)) + objectA + (decorate_inputs argsT argsA))))))])) (def: (invoke::constructor class_loader) (-> java/lang/ClassLoader Handler) @@ -1469,8 +1469,8 @@ _ (phase.assert ..deprecated_method [class ..constructor_method methodT] (not deprecated?)) [outputT argsA] (inferenceA.general archive analyse methodT (list\map product.right argsTC))] - (wrap (#/////analysis.Extension extension_name (list& (/////analysis.text (..signature (jvm.class class (list)))) - (decorate_inputs argsT argsA))))))])) + (in (#/////analysis.Extension extension_name (list& (/////analysis.text (..signature (jvm.class class (list)))) + (decorate_inputs argsT argsA))))))])) (def: (bundle::member class_loader) (-> java/lang/ClassLoader Bundle) @@ -1565,8 +1565,8 @@ exceptions (|> (java/lang/reflect/Method::getGenericExceptionTypes method) array.to_list (monad.map ! reflection!.class))] - (wrap [(java/lang/reflect/Method::getName method) - (jvm.method [type_variables inputs return exceptions])]))))))] + (in [(java/lang/reflect/Method::getName method) + (jvm.method [type_variables inputs return exceptions])]))))))] [abstract_methods (list.only (|>> java/lang/reflect/Method::getModifiers java/lang/reflect/Modifier::isAbstract))] [methods (<|)] @@ -1667,22 +1667,22 @@ [parametersA (monad.map ! (function (_ [name value]) (do ! [valueA (analyse archive value)] - (wrap [name valueA]))) + (in [name valueA]))) parameters)] - (wrap [name parametersA]))) + (in [name parametersA]))) annotations) super_arguments (monad.map ! (function (_ [jvmT super_argC]) (do ! [luxT (reflection_type mapping jvmT) super_argA (typeA.with_type luxT (analyse archive super_argC))] - (wrap [jvmT super_argA]))) + (in [jvmT super_argA]))) super_arguments) arguments' (monad.map ! (function (_ [name jvmT]) (do ! [luxT (boxed_reflection_type mapping jvmT)] - (wrap [name luxT]))) + (in [name luxT]))) arguments) [scope bodyA] (|> arguments' (#.Cons [self_name selfT]) @@ -1690,20 +1690,20 @@ (list\fold scope.with_local (analyse archive body)) (typeA.with_type .Any) /////analysis.with_scope)] - (wrap (/////analysis.tuple (list (/////analysis.text ..constructor_tag) - (visibility_analysis visibility) - (/////analysis.bit strict_fp?) - (/////analysis.tuple (list\map annotation_analysis annotationsA)) - (/////analysis.tuple (list\map var_analysis vars)) - (/////analysis.text self_name) - (/////analysis.tuple (list\map ..argument_analysis arguments)) - (/////analysis.tuple (list\map class_analysis exceptions)) - (/////analysis.tuple (list\map typed_analysis super_arguments)) - (#/////analysis.Function - (list\map (|>> /////analysis.variable) - (scope.environment scope)) - (/////analysis.tuple (list bodyA))) - )))))) + (in (/////analysis.tuple (list (/////analysis.text ..constructor_tag) + (visibility_analysis visibility) + (/////analysis.bit strict_fp?) + (/////analysis.tuple (list\map annotation_analysis annotationsA)) + (/////analysis.tuple (list\map var_analysis vars)) + (/////analysis.text self_name) + (/////analysis.tuple (list\map ..argument_analysis arguments)) + (/////analysis.tuple (list\map class_analysis exceptions)) + (/////analysis.tuple (list\map typed_analysis super_arguments)) + (#/////analysis.Function + (list\map (|>> /////analysis.variable) + (scope.environment scope)) + (/////analysis.tuple (list bodyA))) + )))))) (type: #export (Virtual_Method a) [Text @@ -1749,16 +1749,16 @@ [parametersA (monad.map ! (function (_ [name value]) (do ! [valueA (analyse archive value)] - (wrap [name valueA]))) + (in [name valueA]))) parameters)] - (wrap [name parametersA]))) + (in [name parametersA]))) annotations) returnT (reflection_return mapping return) arguments' (monad.map ! (function (_ [name jvmT]) (do ! [luxT (boxed_reflection_type mapping jvmT)] - (wrap [name luxT]))) + (in [name luxT]))) arguments) [scope bodyA] (|> arguments' (#.Cons [self_name selfT]) @@ -1766,22 +1766,22 @@ (list\fold scope.with_local (analyse archive body)) (typeA.with_type returnT) /////analysis.with_scope)] - (wrap (/////analysis.tuple (list (/////analysis.text ..virtual_tag) - (/////analysis.text method_name) - (visibility_analysis visibility) - (/////analysis.bit final?) - (/////analysis.bit strict_fp?) - (/////analysis.tuple (list\map annotation_analysis annotationsA)) - (/////analysis.tuple (list\map var_analysis vars)) - (/////analysis.text self_name) - (/////analysis.tuple (list\map ..argument_analysis arguments)) - (return_analysis return) - (/////analysis.tuple (list\map class_analysis exceptions)) - (#/////analysis.Function - (list\map (|>> /////analysis.variable) - (scope.environment scope)) - (/////analysis.tuple (list bodyA))) - )))))) + (in (/////analysis.tuple (list (/////analysis.text ..virtual_tag) + (/////analysis.text method_name) + (visibility_analysis visibility) + (/////analysis.bit final?) + (/////analysis.bit strict_fp?) + (/////analysis.tuple (list\map annotation_analysis annotationsA)) + (/////analysis.tuple (list\map var_analysis vars)) + (/////analysis.text self_name) + (/////analysis.tuple (list\map ..argument_analysis arguments)) + (return_analysis return) + (/////analysis.tuple (list\map class_analysis exceptions)) + (#/////analysis.Function + (list\map (|>> /////analysis.variable) + (scope.environment scope)) + (/////analysis.tuple (list bodyA))) + )))))) (type: #export (Static_Method a) [Text @@ -1823,37 +1823,37 @@ [parametersA (monad.map ! (function (_ [name value]) (do ! [valueA (analyse archive value)] - (wrap [name valueA]))) + (in [name valueA]))) parameters)] - (wrap [name parametersA]))) + (in [name parametersA]))) annotations) returnT (reflection_return mapping return) arguments' (monad.map ! (function (_ [name jvmT]) (do ! [luxT (boxed_reflection_type mapping jvmT)] - (wrap [name luxT]))) + (in [name luxT]))) arguments) [scope bodyA] (|> arguments' list.reverse (list\fold scope.with_local (analyse archive body)) (typeA.with_type returnT) /////analysis.with_scope)] - (wrap (/////analysis.tuple (list (/////analysis.text ..static_tag) - (/////analysis.text method_name) - (visibility_analysis visibility) - (/////analysis.bit strict_fp?) - (/////analysis.tuple (list\map annotation_analysis annotationsA)) - (/////analysis.tuple (list\map var_analysis vars)) - (/////analysis.tuple (list\map ..argument_analysis arguments)) - (return_analysis return) - (/////analysis.tuple (list\map class_analysis - exceptions)) - (#/////analysis.Function - (list\map (|>> /////analysis.variable) - (scope.environment scope)) - (/////analysis.tuple (list bodyA))) - )))))) + (in (/////analysis.tuple (list (/////analysis.text ..static_tag) + (/////analysis.text method_name) + (visibility_analysis visibility) + (/////analysis.bit strict_fp?) + (/////analysis.tuple (list\map annotation_analysis annotationsA)) + (/////analysis.tuple (list\map var_analysis vars)) + (/////analysis.tuple (list\map ..argument_analysis arguments)) + (return_analysis return) + (/////analysis.tuple (list\map class_analysis + exceptions)) + (#/////analysis.Function + (list\map (|>> /////analysis.variable) + (scope.environment scope)) + (/////analysis.tuple (list bodyA))) + )))))) (type: #export (Overriden_Method a) [(Type Class) @@ -1918,10 +1918,10 @@ (|> super_parameters (monad.map ! (..reflection_type mapping)) (\ ! map (|>> (list.zipped/2 parent_parameters))))) - (phase.lift (exception.throw ..mismatched_super_parameters [parent_name expected_count actual_count])))) + (phase.lift (exception.except ..mismatched_super_parameters [parent_name expected_count actual_count])))) #.None - (phase.lift (exception.throw ..unknown_super [parent_name supers]))))) + (phase.lift (exception.except ..unknown_super [parent_name supers]))))) (def: #export (with_fresh_type_vars vars mapping) (-> (List (Type Var)) Mapping (Operation Mapping)) @@ -1930,21 +1930,21 @@ (do ! [[_ exT] (typeA.with_env check.existential)] - (wrap [var exT]))) + (in [var exT]))) vars)] - (wrap (list\fold (function (_ [varJ varT] mapping) - (dictionary.put (jvm_parser.name varJ) varT mapping)) - mapping - pairings)))) + (in (list\fold (function (_ [varJ varT] mapping) + (dictionary.put (jvm_parser.name varJ) varT mapping)) + mapping + pairings)))) (def: #export (with_override_mapping supers parent_type mapping) (-> (List (Type Class)) (Type Class) Mapping (Operation Mapping)) (do phase.monad [override_mapping (..override_mapping mapping supers parent_type)] - (wrap (list\fold (function (_ [super_var bound_type] mapping) - (dictionary.put super_var bound_type mapping)) - mapping - override_mapping)))) + (in (list\fold (function (_ [super_var bound_type] mapping) + (dictionary.put super_var bound_type mapping)) + mapping + override_mapping)))) (def: #export (hide_method_body arity bodyA) (-> Nat Analysis Analysis) @@ -1989,15 +1989,15 @@ [parametersA (monad.map ! (function (_ [name value]) (do ! [valueA (analyse archive value)] - (wrap [name valueA]))) + (in [name valueA]))) parameters)] - (wrap [name parametersA]))) + (in [name parametersA]))) annotations) arguments' (monad.map ! (function (_ [name jvmT]) (do ! [luxT (boxed_reflection_type mapping jvmT)] - (wrap [name luxT]))) + (in [name luxT]))) arguments) returnT (boxed_reflection_return mapping return) [scope bodyA] (|> arguments' @@ -2006,22 +2006,22 @@ (list\fold scope.with_local (analyse archive body)) (typeA.with_type returnT) /////analysis.with_scope)] - (wrap (/////analysis.tuple (list (/////analysis.text ..overriden_tag) - (class_analysis parent_type) - (/////analysis.text method_name) - (/////analysis.bit strict_fp?) - (/////analysis.tuple (list\map annotation_analysis annotationsA)) - (/////analysis.tuple (list\map var_analysis vars)) - (/////analysis.text self_name) - (/////analysis.tuple (list\map ..argument_analysis arguments)) - (return_analysis return) - (/////analysis.tuple (list\map class_analysis - exceptions)) - (#/////analysis.Function - (list\map (|>> /////analysis.variable) - (scope.environment scope)) - (..hide_method_body (list.size arguments) bodyA)) - )))))) + (in (/////analysis.tuple (list (/////analysis.text ..overriden_tag) + (class_analysis parent_type) + (/////analysis.text method_name) + (/////analysis.bit strict_fp?) + (/////analysis.tuple (list\map annotation_analysis annotationsA)) + (/////analysis.tuple (list\map var_analysis vars)) + (/////analysis.text self_name) + (/////analysis.tuple (list\map ..argument_analysis arguments)) + (return_analysis return) + (/////analysis.tuple (list\map class_analysis + exceptions)) + (#/////analysis.Function + (list\map (|>> /////analysis.variable) + (scope.environment scope)) + (..hide_method_body (list.size arguments) bodyA)) + )))))) (type: #export (Method_Definition a) (#Overriden_Method (Overriden_Method a))) @@ -2032,7 +2032,7 @@ (function (_ parameterJ) (do check.monad [[_ parameterT] check.existential] - (wrap [parameterJ parameterT]))))) + (in [parameterJ parameterT]))))) (def: (mismatched_methods super_set sub_set) (-> (List [Text (Type Method)]) @@ -2067,15 +2067,15 @@ _ (phase.assert ..class_parameter_mismatch [expected_parameters actual_parameters] (n.= (list.size expected_parameters) (list.size actual_parameters)))] - (wrap (|> (list.zipped/2 expected_parameters actual_parameters) - (list\fold (function (_ [expected actual] mapping) - (case (jvm_parser.var? actual) - (#.Some actual) - (dictionary.put actual expected mapping) - - #.None - mapping)) - jvm_alias.fresh))))) + (in (|> (list.zipped/2 expected_parameters actual_parameters) + (list\fold (function (_ [expected actual] mapping) + (case (jvm_parser.var? actual) + (#.Some actual) + (dictionary.put actual expected mapping) + + #.None + mapping)) + jvm_alias.fresh))))) (def: (anonymous_class_name module id) (-> Module Nat Text) @@ -2094,11 +2094,11 @@ body]) (do ! [aliasing (super_aliasing class_loader parent_type)] - (wrap [method_name (|> (jvm.method [type_vars - (list\map product.right arguments) - return - exceptions]) - (jvm_alias.method aliasing))]))) + (in [method_name (|> (jvm.method [type_vars + (list\map product.right arguments) + return + exceptions]) + (jvm_alias.method aliasing))]))) methods) #let [missing_abstract_methods (mismatched_methods overriden_methods required_abstract_methods) invalid_overriden_methods (mismatched_methods available_methods overriden_methods)] @@ -2106,7 +2106,7 @@ (list.empty? missing_abstract_methods)) _ (phase.assert ..invalid_overriden_methods invalid_overriden_methods (list.empty? invalid_overriden_methods))] - (wrap []))) + (in []))) (def: (class::anonymous class_loader) (-> java/lang/ClassLoader Handler) @@ -2142,25 +2142,25 @@ selfT (///.lift (do meta.monad [where meta.current_module_name id meta.count] - (wrap (inheritance_relationship_type (#.Primitive (..anonymous_class_name where id) (list)) - super_classT - super_interfaceT+)))) + (in (inheritance_relationship_type (#.Primitive (..anonymous_class_name where id) (list)) + super_classT + super_interfaceT+)))) _ (typeA.infer selfT) constructor_argsA+ (monad.map ! (function (_ [type term]) (do ! [argT (reflection_type mapping type) termA (typeA.with_type argT (analyse archive term))] - (wrap [type termA]))) + (in [type termA]))) constructor_args) #let [supers (#.Cons super_class super_interfaces)] _ (..require_complete_method_concretion class_loader supers methods) methodsA (monad.map ! (analyse_overriden_method analyse archive selfT mapping supers) methods)] - (wrap (#/////analysis.Extension extension_name - (list (class_analysis super_class) - (/////analysis.tuple (list\map class_analysis super_interfaces)) - (/////analysis.tuple (list\map typed_analysis constructor_argsA+)) - (/////analysis.tuple methodsA))))))])) + (in (#/////analysis.Extension extension_name + (list (class_analysis super_class) + (/////analysis.tuple (list\map class_analysis super_interfaces)) + (/////analysis.tuple (list\map typed_analysis constructor_argsA+)) + (/////analysis.tuple methodsA))))))])) (def: (bundle::class class_loader) (-> java/lang/ClassLoader Bundle) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/lua.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/lua.lux index b0bdba0cb..9fc9ce902 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/lua.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/lua.lux @@ -50,7 +50,7 @@ (phase archive lengthC)) [var_id varT] (analysis/type.with_env check.var) _ (analysis/type.infer (type (Array varT)))] - (wrap (#analysis.Extension extension (list lengthA)))))])) + (in (#analysis.Extension extension (list lengthA)))))])) (def: array::length Handler @@ -62,7 +62,7 @@ arrayA (analysis/type.with_type (type (Array varT)) (phase archive arrayC)) _ (analysis/type.infer Nat)] - (wrap (#analysis.Extension extension (list arrayA)))))])) + (in (#analysis.Extension extension (list arrayA)))))])) (def: array::read Handler @@ -76,7 +76,7 @@ arrayA (analysis/type.with_type (type (Array varT)) (phase archive arrayC)) _ (analysis/type.infer varT)] - (wrap (#analysis.Extension extension (list indexA arrayA)))))])) + (in (#analysis.Extension extension (list indexA arrayA)))))])) (def: array::write Handler @@ -92,7 +92,7 @@ arrayA (analysis/type.with_type (type (Array varT)) (phase archive arrayC)) _ (analysis/type.infer (type (Array varT)))] - (wrap (#analysis.Extension extension (list indexA valueA arrayA)))))])) + (in (#analysis.Extension extension (list indexA valueA arrayA)))))])) (def: array::delete Handler @@ -106,7 +106,7 @@ arrayA (analysis/type.with_type (type (Array varT)) (phase archive arrayC)) _ (analysis/type.infer (type (Array varT)))] - (wrap (#analysis.Extension extension (list indexA arrayA)))))])) + (in (#analysis.Extension extension (list indexA arrayA)))))])) (def: bundle::array Bundle @@ -128,8 +128,8 @@ [objectA (analysis/type.with_type ..Object (phase archive objectC)) _ (analysis/type.infer .Any)] - (wrap (#analysis.Extension extension (list (analysis.text fieldC) - objectA)))))])) + (in (#analysis.Extension extension (list (analysis.text fieldC) + objectA)))))])) (def: object::do Handler @@ -141,9 +141,9 @@ (phase archive objectC)) inputsA (monad.map ! (|>> (phase archive) (analysis/type.with_type Any)) inputsC) _ (analysis/type.infer .Any)] - (wrap (#analysis.Extension extension (list& (analysis.text methodC) - objectA - inputsA)))))])) + (in (#analysis.Extension extension (list& (analysis.text methodC) + objectA + inputsA)))))])) (def: bundle::object Bundle @@ -165,7 +165,7 @@ [inputA (analysis/type.with_type (type <fromT>) (phase archive inputC)) _ (analysis/type.infer (type <toT>))] - (wrap (#analysis.Extension extension (list inputA)))))]))] + (in (#analysis.Extension extension (list inputA)))))]))] [utf8::encode Text (array.Array (I64 Any))] [utf8::decode (array.Array (I64 Any)) Text] @@ -186,7 +186,7 @@ (function (_ extension phase archive name) (do phase.monad [_ (analysis/type.infer Any)] - (wrap (#analysis.Extension extension (list (analysis.text name))))))])) + (in (#analysis.Extension extension (list (analysis.text name))))))])) (def: lua::apply Handler @@ -198,7 +198,7 @@ (phase archive abstractionC)) inputsA (monad.map ! (|>> (phase archive) (analysis/type.with_type Any)) inputsC) _ (analysis/type.infer Any)] - (wrap (#analysis.Extension extension (list& abstractionA inputsA)))))])) + (in (#analysis.Extension extension (list& abstractionA inputsA)))))])) (def: lua::power Handler @@ -211,7 +211,7 @@ baseA (analysis/type.with_type Frac (phase archive baseC)) _ (analysis/type.infer Frac)] - (wrap (#analysis.Extension extension (list powerA baseA)))))])) + (in (#analysis.Extension extension (list powerA baseA)))))])) (def: lua::import Handler @@ -220,7 +220,7 @@ (function (_ extension phase archive name) (do phase.monad [_ (analysis/type.infer ..Object)] - (wrap (#analysis.Extension extension (list (analysis.text name))))))])) + (in (#analysis.Extension extension (list (analysis.text name))))))])) (def: lua::function Handler @@ -232,8 +232,8 @@ abstractionA (analysis/type.with_type (-> inputT Any) (phase archive abstractionC)) _ (analysis/type.infer ..Function)] - (wrap (#analysis.Extension extension (list (analysis.nat arity) - abstractionA)))))])) + (in (#analysis.Extension extension (list (analysis.nat arity) + abstractionA)))))])) (def: #export bundle Bundle diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux index 2804d568f..78d3b7aac 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux @@ -45,7 +45,7 @@ (handler extension_name analyse archive inputs) (#try.Failure _) - (////analysis.throw ///.invalid_syntax [extension_name %.code args])))) + (////analysis.except ///.invalid_syntax [extension_name %.code args])))) (def: (simple inputsT+ outputT) (-> (List Type) Type Handler) @@ -60,8 +60,8 @@ (typeA.with_type argT (analyse archive argC))) (list.zipped/2 inputsT+ args))] - (wrap (#////analysis.Extension extension_name argsA))) - (////analysis.throw ///.incorrect_arity [extension_name num_expected num_actual])))))) + (in (#////analysis.Extension extension_name argsA))) + (////analysis.except ///.incorrect_arity [extension_name num_expected num_actual])))))) (def: #export (nullary valueT) (-> Type Handler) @@ -90,7 +90,7 @@ (do <>.monad [raw <code>.text] (case (text.size raw) - 1 (wrap (|> raw (text.nth 0) maybe.assume)) + 1 (in (|> raw (text.nth 0) maybe.assume)) _ (<>.failure (exception.construct ..char_text_must_be_size_1 [raw]))))) (def: lux::syntax_char_case! @@ -109,17 +109,17 @@ (do ! [branch (typeA.with_type expectedT (phase archive branch))] - (wrap [cases branch]))) + (in [cases branch]))) conditionals) else (typeA.with_type expectedT (phase archive else))] - (wrap (|> conditionals - (list\map (function (_ [cases branch]) - (////analysis.tuple - (list (////analysis.tuple (list\map (|>> ////analysis.nat) cases)) - branch)))) - (list& input else) - (#////analysis.Extension extension_name)))))]))) + (in (|> conditionals + (list\map (function (_ [cases branch]) + (////analysis.tuple + (list (////analysis.tuple (list\map (|>> ////analysis.nat) cases)) + branch)))) + (list& input else) + (#////analysis.Extension extension_name)))))]))) ## "lux is" represents reference/pointer equality. (def: lux::is @@ -142,10 +142,10 @@ _ (typeA.infer (type (Either Text varT))) opA (typeA.with_type (type (-> .Any varT)) (analyse archive opC))] - (wrap (#////analysis.Extension extension_name (list opA)))) + (in (#////analysis.Extension extension_name (list opA)))) _ - (////analysis.throw ///.incorrect_arity [extension_name 1 (list.size args)])))) + (////analysis.except ///.incorrect_arity [extension_name 1 (list.size args)])))) (def: lux::in_module Handler @@ -156,7 +156,7 @@ (analyse archive exprC)) _ - (////analysis.throw ///.invalid_syntax [extension_name %.code argsC+])))) + (////analysis.except ///.invalid_syntax [extension_name %.code argsC+])))) (def: (lux::type::check eval) (-> Eval Handler) @@ -172,7 +172,7 @@ (analyse archive valueC))) _ - (////analysis.throw ///.incorrect_arity [extension_name 2 (list.size args)])))) + (////analysis.except ///.incorrect_arity [extension_name 2 (list.size args)])))) (def: (lux::type::as eval) (-> Eval Handler) @@ -186,10 +186,10 @@ _ (typeA.infer actualT) [valueT valueA] (typeA.with_inference (analyse archive valueC))] - (wrap valueA)) + (in valueA)) _ - (////analysis.throw ///.incorrect_arity [extension_name 2 (list.size args)])))) + (////analysis.except ///.incorrect_arity [extension_name 2 (list.size args)])))) (def: (caster input output) (-> Type Type Handler) @@ -210,10 +210,10 @@ [_ (typeA.infer .Macro) input_type (loop [input_name (name_of .Macro')] (do ! - [input_type (///.lift (meta.find_def (name_of .Macro')))] + [input_type (///.lift (meta.definition (name_of .Macro')))] (case input_type (#.Definition [exported? def_type def_data def_value]) - (wrap (:as Type def_value)) + (in (:as Type def_value)) (#.Alias real_name) (recur real_name))))] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/php.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/php.lux index a30c9e6f0..40cf1f094 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/php.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/php.lux @@ -38,7 +38,7 @@ (phase archive lengthC)) [var_id varT] (analysis/type.with_env check.var) _ (analysis/type.infer (type (Array varT)))] - (wrap (#analysis.Extension extension (list lengthA)))))])) + (in (#analysis.Extension extension (list lengthA)))))])) (def: array::length Handler @@ -50,7 +50,7 @@ arrayA (analysis/type.with_type (type (Array varT)) (phase archive arrayC)) _ (analysis/type.infer Nat)] - (wrap (#analysis.Extension extension (list arrayA)))))])) + (in (#analysis.Extension extension (list arrayA)))))])) (def: array::read Handler @@ -64,7 +64,7 @@ arrayA (analysis/type.with_type (type (Array varT)) (phase archive arrayC)) _ (analysis/type.infer varT)] - (wrap (#analysis.Extension extension (list indexA arrayA)))))])) + (in (#analysis.Extension extension (list indexA arrayA)))))])) (def: array::write Handler @@ -80,7 +80,7 @@ arrayA (analysis/type.with_type (type (Array varT)) (phase archive arrayC)) _ (analysis/type.infer (type (Array varT)))] - (wrap (#analysis.Extension extension (list indexA valueA arrayA)))))])) + (in (#analysis.Extension extension (list indexA valueA arrayA)))))])) (def: array::delete Handler @@ -94,7 +94,7 @@ arrayA (analysis/type.with_type (type (Array varT)) (phase archive arrayC)) _ (analysis/type.infer (type (Array varT)))] - (wrap (#analysis.Extension extension (list indexA arrayA)))))])) + (in (#analysis.Extension extension (list indexA arrayA)))))])) (def: bundle::array Bundle @@ -127,7 +127,7 @@ (do {! phase.monad} [inputsA (monad.map ! (|>> (phase archive) (analysis/type.with_type Any)) inputsC) _ (analysis/type.infer .Any)] - (wrap (#analysis.Extension extension (list& (analysis.text constructor) inputsA)))))])) + (in (#analysis.Extension extension (list& (analysis.text constructor) inputsA)))))])) (def: object::get Handler @@ -138,8 +138,8 @@ [objectA (analysis/type.with_type ..Object (phase archive objectC)) _ (analysis/type.infer .Any)] - (wrap (#analysis.Extension extension (list (analysis.text fieldC) - objectA)))))])) + (in (#analysis.Extension extension (list (analysis.text fieldC) + objectA)))))])) (def: object::do Handler @@ -151,9 +151,9 @@ (phase archive objectC)) inputsA (monad.map ! (|>> (phase archive) (analysis/type.with_type Any)) inputsC) _ (analysis/type.infer .Any)] - (wrap (#analysis.Extension extension (list& (analysis.text methodC) - objectA - inputsA)))))])) + (in (#analysis.Extension extension (list& (analysis.text methodC) + objectA + inputsA)))))])) (def: bundle::object Bundle @@ -173,7 +173,7 @@ (function (_ extension phase archive name) (do phase.monad [_ (analysis/type.infer Any)] - (wrap (#analysis.Extension extension (list (analysis.text name))))))])) + (in (#analysis.Extension extension (list (analysis.text name))))))])) (def: php::apply Handler @@ -185,7 +185,7 @@ (phase archive abstractionC)) inputsA (monad.map ! (|>> (phase archive) (analysis/type.with_type Any)) inputsC) _ (analysis/type.infer Any)] - (wrap (#analysis.Extension extension (list& abstractionA inputsA)))))])) + (in (#analysis.Extension extension (list& abstractionA inputsA)))))])) (def: php::pack Handler @@ -198,7 +198,7 @@ dataA (analysis/type.with_type (type (Array (I64 Any))) (phase archive dataC)) _ (analysis/type.infer Text)] - (wrap (#analysis.Extension extension (list formatA dataA)))))])) + (in (#analysis.Extension extension (list formatA dataA)))))])) (def: #export bundle Bundle diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/python.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/python.lux index a3635cf96..6d5e3290f 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/python.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/python.lux @@ -38,7 +38,7 @@ (phase archive lengthC)) [var_id varT] (analysis/type.with_env check.var) _ (analysis/type.infer (type (Array varT)))] - (wrap (#analysis.Extension extension (list lengthA)))))])) + (in (#analysis.Extension extension (list lengthA)))))])) (def: array::length Handler @@ -50,7 +50,7 @@ arrayA (analysis/type.with_type (type (Array varT)) (phase archive arrayC)) _ (analysis/type.infer Nat)] - (wrap (#analysis.Extension extension (list arrayA)))))])) + (in (#analysis.Extension extension (list arrayA)))))])) (def: array::read Handler @@ -64,7 +64,7 @@ arrayA (analysis/type.with_type (type (Array varT)) (phase archive arrayC)) _ (analysis/type.infer varT)] - (wrap (#analysis.Extension extension (list indexA arrayA)))))])) + (in (#analysis.Extension extension (list indexA arrayA)))))])) (def: array::write Handler @@ -80,7 +80,7 @@ arrayA (analysis/type.with_type (type (Array varT)) (phase archive arrayC)) _ (analysis/type.infer (type (Array varT)))] - (wrap (#analysis.Extension extension (list indexA valueA arrayA)))))])) + (in (#analysis.Extension extension (list indexA valueA arrayA)))))])) (def: array::delete Handler @@ -94,7 +94,7 @@ arrayA (analysis/type.with_type (type (Array varT)) (phase archive arrayC)) _ (analysis/type.infer (type (Array varT)))] - (wrap (#analysis.Extension extension (list indexA arrayA)))))])) + (in (#analysis.Extension extension (list indexA arrayA)))))])) (def: bundle::array Bundle @@ -133,8 +133,8 @@ [objectA (analysis/type.with_type ..Object (phase archive objectC)) _ (analysis/type.infer .Any)] - (wrap (#analysis.Extension extension (list (analysis.text fieldC) - objectA)))))])) + (in (#analysis.Extension extension (list (analysis.text fieldC) + objectA)))))])) (def: object::do Handler @@ -146,9 +146,9 @@ (phase archive objectC)) inputsA (monad.map ! (|>> (phase archive) (analysis/type.with_type Any)) inputsC) _ (analysis/type.infer .Any)] - (wrap (#analysis.Extension extension (list& (analysis.text methodC) - objectA - inputsA)))))])) + (in (#analysis.Extension extension (list& (analysis.text methodC) + objectA + inputsA)))))])) (def: bundle::object Bundle @@ -167,7 +167,7 @@ (function (_ extension phase archive name) (do phase.monad [_ (analysis/type.infer Any)] - (wrap (#analysis.Extension extension (list (analysis.text name))))))])) + (in (#analysis.Extension extension (list (analysis.text name))))))])) (def: python::import Handler @@ -176,7 +176,7 @@ (function (_ extension phase archive name) (do phase.monad [_ (analysis/type.infer ..Object)] - (wrap (#analysis.Extension extension (list (analysis.text name))))))])) + (in (#analysis.Extension extension (list (analysis.text name))))))])) (def: python::apply Handler @@ -188,7 +188,7 @@ (phase archive abstractionC)) inputsA (monad.map ! (|>> (phase archive) (analysis/type.with_type Any)) inputsC) _ (analysis/type.infer Any)] - (wrap (#analysis.Extension extension (list& abstractionA inputsA)))))])) + (in (#analysis.Extension extension (list& abstractionA inputsA)))))])) (def: python::function Handler @@ -200,8 +200,8 @@ abstractionA (analysis/type.with_type (-> inputT Any) (phase archive abstractionC)) _ (analysis/type.infer ..Function)] - (wrap (#analysis.Extension extension (list (analysis.nat arity) - abstractionA)))))])) + (in (#analysis.Extension extension (list (analysis.nat arity) + abstractionA)))))])) (def: python::exec Handler @@ -214,7 +214,7 @@ globalsA (analysis/type.with_type ..Dict (phase archive globalsC)) _ (analysis/type.infer .Any)] - (wrap (#analysis.Extension extension (list codeA globalsA)))))])) + (in (#analysis.Extension extension (list codeA globalsA)))))])) (def: #export bundle Bundle diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/ruby.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/ruby.lux index 1d01b479d..65650c837 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/ruby.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/ruby.lux @@ -38,7 +38,7 @@ (phase archive lengthC)) [var_id varT] (analysis/type.with_env check.var) _ (analysis/type.infer (type (Array varT)))] - (wrap (#analysis.Extension extension (list lengthA)))))])) + (in (#analysis.Extension extension (list lengthA)))))])) (def: array::length Handler @@ -50,7 +50,7 @@ arrayA (analysis/type.with_type (type (Array varT)) (phase archive arrayC)) _ (analysis/type.infer Nat)] - (wrap (#analysis.Extension extension (list arrayA)))))])) + (in (#analysis.Extension extension (list arrayA)))))])) (def: array::read Handler @@ -64,7 +64,7 @@ arrayA (analysis/type.with_type (type (Array varT)) (phase archive arrayC)) _ (analysis/type.infer varT)] - (wrap (#analysis.Extension extension (list indexA arrayA)))))])) + (in (#analysis.Extension extension (list indexA arrayA)))))])) (def: array::write Handler @@ -80,7 +80,7 @@ arrayA (analysis/type.with_type (type (Array varT)) (phase archive arrayC)) _ (analysis/type.infer (type (Array varT)))] - (wrap (#analysis.Extension extension (list indexA valueA arrayA)))))])) + (in (#analysis.Extension extension (list indexA valueA arrayA)))))])) (def: array::delete Handler @@ -94,7 +94,7 @@ arrayA (analysis/type.with_type (type (Array varT)) (phase archive arrayC)) _ (analysis/type.infer (type (Array varT)))] - (wrap (#analysis.Extension extension (list indexA arrayA)))))])) + (in (#analysis.Extension extension (list indexA arrayA)))))])) (def: bundle::array Bundle @@ -128,8 +128,8 @@ [objectA (analysis/type.with_type ..Object (phase archive objectC)) _ (analysis/type.infer .Any)] - (wrap (#analysis.Extension extension (list (analysis.text fieldC) - objectA)))))])) + (in (#analysis.Extension extension (list (analysis.text fieldC) + objectA)))))])) (def: object::do Handler @@ -141,9 +141,9 @@ (phase archive objectC)) inputsA (monad.map ! (|>> (phase archive) (analysis/type.with_type Any)) inputsC) _ (analysis/type.infer .Any)] - (wrap (#analysis.Extension extension (list& (analysis.text methodC) - objectA - inputsA)))))])) + (in (#analysis.Extension extension (list& (analysis.text methodC) + objectA + inputsA)))))])) (def: bundle::object Bundle @@ -162,7 +162,7 @@ (function (_ extension phase archive name) (do phase.monad [_ (analysis/type.infer Any)] - (wrap (#analysis.Extension extension (list (analysis.text name))))))])) + (in (#analysis.Extension extension (list (analysis.text name))))))])) (def: ruby::apply Handler @@ -174,7 +174,7 @@ (phase archive abstractionC)) inputsA (monad.map ! (|>> (phase archive) (analysis/type.with_type Any)) inputsC) _ (analysis/type.infer Any)] - (wrap (#analysis.Extension extension (list& abstractionA inputsA)))))])) + (in (#analysis.Extension extension (list& abstractionA inputsA)))))])) (def: ruby::import Handler @@ -183,7 +183,7 @@ (function (_ extension phase archive name) (do phase.monad [_ (analysis/type.infer Bit)] - (wrap (#analysis.Extension extension (list (analysis.text name))))))])) + (in (#analysis.Extension extension (list (analysis.text name))))))])) (def: #export bundle Bundle diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/scheme.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/scheme.lux index e7ff4ba15..8e309a9de 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/scheme.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/scheme.lux @@ -38,7 +38,7 @@ (phase archive lengthC)) [var_id varT] (analysis/type.with_env check.var) _ (analysis/type.infer (type (Array varT)))] - (wrap (#analysis.Extension extension (list lengthA)))))])) + (in (#analysis.Extension extension (list lengthA)))))])) (def: array::length Handler @@ -50,7 +50,7 @@ arrayA (analysis/type.with_type (type (Array varT)) (phase archive arrayC)) _ (analysis/type.infer Nat)] - (wrap (#analysis.Extension extension (list arrayA)))))])) + (in (#analysis.Extension extension (list arrayA)))))])) (def: array::read Handler @@ -64,7 +64,7 @@ arrayA (analysis/type.with_type (type (Array varT)) (phase archive arrayC)) _ (analysis/type.infer varT)] - (wrap (#analysis.Extension extension (list indexA arrayA)))))])) + (in (#analysis.Extension extension (list indexA arrayA)))))])) (def: array::write Handler @@ -80,7 +80,7 @@ arrayA (analysis/type.with_type (type (Array varT)) (phase archive arrayC)) _ (analysis/type.infer (type (Array varT)))] - (wrap (#analysis.Extension extension (list indexA valueA arrayA)))))])) + (in (#analysis.Extension extension (list indexA valueA arrayA)))))])) (def: array::delete Handler @@ -94,7 +94,7 @@ arrayA (analysis/type.with_type (type (Array varT)) (phase archive arrayC)) _ (analysis/type.infer (type (Array varT)))] - (wrap (#analysis.Extension extension (list indexA arrayA)))))])) + (in (#analysis.Extension extension (list indexA arrayA)))))])) (def: bundle::array Bundle @@ -131,7 +131,7 @@ (function (_ extension phase archive name) (do phase.monad [_ (analysis/type.infer Any)] - (wrap (#analysis.Extension extension (list (analysis.text name))))))])) + (in (#analysis.Extension extension (list (analysis.text name))))))])) (def: scheme::apply Handler @@ -143,7 +143,7 @@ (phase archive abstractionC)) inputsA (monad.map ! (|>> (phase archive) (analysis/type.with_type Any)) inputsC) _ (analysis/type.infer Any)] - (wrap (#analysis.Extension extension (list& abstractionA inputsA)))))])) + (in (#analysis.Extension extension (list& abstractionA inputsA)))))])) (def: #export bundle Bundle diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux index d11c6cb49..a3265adb0 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux @@ -77,7 +77,7 @@ (Parser (Modifier field.Field)) (`` ($_ <>.either (~~ (template [<label> <modifier>] - [(<>.after (<c>.text! <label>) (<>\wrap <modifier>))] + [(<>.after (<c>.text! <label>) (<>\in <modifier>))] ["public" field.public] ["private" field.private] @@ -88,7 +88,7 @@ (Parser (Modifier class.Class)) (`` ($_ <>.either (~~ (template [<label> <modifier>] - [(<>.after (<c>.text! <label>) (<>\wrap <modifier>))] + [(<>.after (<c>.text! <label>) (<>\in <modifier>))] ["final" class.final] ["abstract" class.abstract] @@ -98,7 +98,7 @@ (Parser (Modifier field.Field)) (`` ($_ <>.either (~~ (template [<label> <modifier>] - [(<>.after (<c>.text! <label>) (<>\wrap <modifier>))] + [(<>.after (<c>.text! <label>) (<>\in <modifier>))] ["volatile" field.volatile] ["final" field.final] @@ -110,9 +110,9 @@ (Parser Annotation) <c>.any) -(def: field-type +(def: field_type (Parser (Type Value)) - (<t>.embed parser.value <c>.text)) + (<t>.then parser.value <c>.text)) (type: Constant [Text (List Annotation) (Type Value) Code]) @@ -124,7 +124,7 @@ ($_ <>.and <c>.text (<c>.tuple (<>.some ..annotation)) - ..field-type + ..field_type <c>.any ))) @@ -140,7 +140,7 @@ ..visibility ..state (<c>.tuple (<>.some ..annotation)) - ..field-type + ..field_type ))) (type: Field @@ -154,26 +154,26 @@ ..variable )) -(type: Method-Definition +(type: Method_Definition (#Constructor (jvm.Constructor Code)) - (#Virtual-Method (jvm.Virtual-Method Code)) - (#Static-Method (jvm.Static-Method Code)) - (#Overriden-Method (jvm.Overriden-Method Code))) + (#Virtual_Method (jvm.Virtual_Method Code)) + (#Static_Method (jvm.Static_Method Code)) + (#Overriden_Method (jvm.Overriden_Method Code))) (def: method - (Parser Method-Definition) + (Parser Method_Definition) ($_ <>.or - jvm.constructor-definition - jvm.virtual-method-definition - jvm.static-method-definition - jvm.overriden-method-definition + jvm.constructor_definition + jvm.virtual_method_definition + jvm.static_method_definition + jvm.overriden_method_definition )) (def: (constraint name) (-> Text Constraint) {#type.name name - #type.super-class (type.class "java.lang.Object" (list)) - #type.super-interfaces (list)}) + #type.super_class (type.class "java.lang.Object" (list)) + #type.super_interfaces (list)}) (def: constant::modifier (Modifier field.Field) @@ -182,7 +182,7 @@ field.static field.final)) -(def: (field-definition field) +(def: (field_definition field) (-> Field (Resource field.Field)) (case field ## TODO: Handle annotations. @@ -199,7 +199,7 @@ [#.Int type.short [.i64 i32.i32 constant.integer pool.integer]] [#.Int type.int [.i64 i32.i32 constant.integer pool.integer]] [#.Int type.long [constant.long pool.long]] - [#.Frac type.float [host.double-to-float constant.float pool.float]] + [#.Frac type.float [host.double_to_float constant.float pool.float]] [#.Frac type.double [constant.double pool.double]] [#.Nat type.char [.i64 i32.i32 constant.integer pool.integer]] [#.Text (type.class "java.lang.String" (list)) [pool.string]] @@ -214,29 +214,29 @@ (field.field (modifier\compose visibility state) name type (row.row)))) -(def: (method-definition [mapping selfT] [analyse synthesize generate]) +(def: (method_definition [mapping selfT] [analyse synthesize generate]) (-> [Mapping .Type] [analysis.Phase synthesis.Phase (generation.Phase Anchor (Bytecode Any) Definition)] - (-> Method-Definition (Operation synthesis.Synthesis))) + (-> Method_Definition (Operation synthesis.Synthesis))) (function (_ methodC) (do phase.monad [methodA (: (Operation analysis.Analysis) - (directive.lift-analysis + (directive.lift_analysis (case methodC (#Constructor method) - (jvm.analyse-constructor-method analyse selfT mapping method) + (jvm.analyse_constructor_method analyse selfT mapping method) - (#Virtual-Method method) - (jvm.analyse-virtual-method analyse selfT mapping method) + (#Virtual_Method method) + (jvm.analyse_virtual_method analyse selfT mapping method) - (#Static-Method method) - (jvm.analyse-static-method analyse mapping method) + (#Static_Method method) + (jvm.analyse_static_method analyse mapping method) - (#Overriden-Method method) - (jvm.analyse-overriden-method analyse selfT mapping method))))] - (directive.lift-synthesis + (#Overriden_Method method) + (jvm.analyse_overriden_method analyse selfT mapping method))))] + (directive.lift_synthesis (synthesize methodA))))) (def: jvm::class @@ -252,51 +252,51 @@ (<c>.tuple (<>.some ..method))) (function (_ extension phase [[name parameters] - super-class - super-interfaces + super_class + super_interfaces inheritance ## TODO: Handle annotations. annotations fields methods]) (do {! phase.monad} - [parameters (directive.lift-analysis - (typeA.with-env - (jvm.parameter-types parameters))) + [parameters (directive.lift_analysis + (typeA.with_env + (jvm.parameter_types parameters))) #let [mapping (list\fold (function (_ [parameterJ parameterT] mapping) (dictionary.put (parser.name parameterJ) parameterT mapping)) luxT.fresh parameters)] - super-classT (directive.lift-analysis - (typeA.with-env - (luxT.check (luxT.class mapping) (..signature super-class)))) - super-interfaceT+ (directive.lift-analysis - (typeA.with-env + super_classT (directive.lift_analysis + (typeA.with_env + (luxT.check (luxT.class mapping) (..signature super_class)))) + super_interfaceT+ (directive.lift_analysis + (typeA.with_env (monad.map check.monad (|>> ..signature (luxT.check (luxT.class mapping))) - super-interfaces))) - #let [selfT (jvm.inheritance-relationship-type (#.Primitive name (list\map product.right parameters)) - super-classT - super-interfaceT+)] - state (extension.lift phase.get-state) + super_interfaces))) + #let [selfT (jvm.inheritance_relationship_type (#.Primitive name (list\map product.right parameters)) + super_classT + super_interfaceT+)] + state (extension.lift phase.get_state) #let [analyse (get@ [#directive.analysis #directive.phase] state) synthesize (get@ [#directive.synthesis #directive.phase] state) generate (get@ [#directive.generation #directive.phase] state)] - methods (monad.map ! (..method-definition [mapping selfT] [analyse synthesize generate]) + methods (monad.map ! (..method_definition [mapping selfT] [analyse synthesize generate]) methods) - ## _ (directive.lift-generation + ## _ (directive.lift_generation ## (generation.save! true ["" name] ## [name ## (class.class version.v6_0 ## (modifier\compose class.public inheritance) ## (name.internal name) (list\map (|>> product.left parser.name ..constraint) parameters) - ## super-class super-interfaces - ## (list\map ..field-definition fields) + ## super_class super_interfaces + ## (list\map ..field_definition fields) ## (list) ## TODO: Add methods ## (row.row))])) - _ (directive.lift-generation + _ (directive.lift_generation (generation.log! (format "Class " name)))] - (wrap directive.no-requirements)))])) + (in directive.no_requirements)))])) (def: #export bundle (Bundle Anchor (Bytecode Any) Definition) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux index b67f9287b..d70b59aef 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux @@ -59,7 +59,7 @@ (handler extension_name phase archive inputs) (#try.Failure error) - (phase.throw ///.invalid_syntax [extension_name %.code inputs])))) + (phase.except ///.invalid_syntax [extension_name %.code inputs])))) (def: (context [module_id artifact_id]) (-> Context Context) @@ -81,7 +81,7 @@ codeG (generate archive codeS) module_id (/////generation.module_id module archive) codeV (/////generation.evaluate! (..context [module_id id]) codeG)] - (wrap [code//type codeG codeV])))) + (in [code//type codeG codeV])))) (def: #export (evaluate! archive type codeC) (All [anchor expression directive] @@ -116,7 +116,7 @@ module_id (phase.lift (archive.id module archive)) [target_name value directive] (/////generation.define! [module_id id] #.None codeG) _ (/////generation.save! id #.None directive)] - (wrap [code//type codeG value])))) + (in [code//type codeG value])))) (def: (definition archive name expected codeC) (All [anchor expression directive] @@ -137,13 +137,13 @@ (analyse archive codeC)) code//type (typeA.with_env (check.clean code//type))] - (wrap [code//type codeA])) + (in [code//type codeA])) (#.Some expected) (do ! [codeA (typeA.with_type expected (analyse archive codeC))] - (wrap [expected codeA])))))) + (in [expected codeA])))))) codeS (/////directive.lift_synthesis (synthesize archive codeA))] (definition' archive generate name code//type codeS))) @@ -168,7 +168,7 @@ id (<learn> extension) [target_name value directive] (/////generation.define! [module_id id] #.None codeG) _ (/////generation.save! id #.None directive)] - (wrap [codeG value]))))) + (in [codeG value]))))) (def: #export (<full> archive extension codeT codeC) (All [anchor expression directive] @@ -231,10 +231,10 @@ (module.define short_name (#.Right [exported? type (:as Code annotations) value]))) _ (..refresh expander host_analysis) _ (..announce_definition! short_name type)] - (wrap /////directive.no_requirements)) + (in /////directive.no_requirements)) _ - (phase.throw ///.invalid_syntax [extension_name %.code inputsC+])))) + (phase.except ///.invalid_syntax [extension_name %.code inputsC+])))) (def: (def::type_tagged expander host_analysis) (-> Expander /////analysis.Bundle Handler) @@ -254,7 +254,7 @@ (module.declare_tags tags exported? (:as Type value)))) _ (..refresh expander host_analysis) _ (..announce_definition! short_name type)] - (wrap /////directive.no_requirements)))])) + (in /////directive.no_requirements)))])) (def: imports (Parser (List Import)) @@ -276,12 +276,12 @@ (do ! [_ (module.import module)] (case alias - "" (wrap []) + "" (in []) _ (module.alias alias module)))) imports)] (module.set_annotations annotationsV)))] - (wrap {#/////directive.imports imports - #/////directive.referrals (list)})))])) + (in {#/////directive.imports imports + #/////directive.referrals (list)})))])) (exception: #export (cannot_alias_an_alias {local Alias} {foreign Alias} {target Name}) (exception.report @@ -293,10 +293,10 @@ (-> Text Name (/////analysis.Operation Any)) (do phase.monad [current_module (///.lift meta.current_module_name) - constant (///.lift (meta.find_def original))] + constant (///.lift (meta.definition original))] (case constant (#.Left de_aliased) - (phase.throw ..cannot_alias_an_alias [[current_module alias] original de_aliased]) + (phase.except ..cannot_alias_an_alias [[current_module alias] original de_aliased]) (#.Right [exported? original_type original_annotations original_value]) (module.define alias (#.Left original))))) @@ -311,7 +311,7 @@ (phase.sub [(get@ [#/////directive.analysis #/////directive.state]) (set@ [#/////directive.analysis #/////directive.state])] (define_alias alias def_name)))] - (wrap /////directive.no_requirements)))])) + (in /////directive.no_requirements)))])) (template [<description> <mame> <def_type> <type> <scope> <definer>] [(def: (<mame> [anchorT expressionT directiveT] extender) @@ -336,10 +336,10 @@ (:assume handlerV))) _ (/////directive.lift_generation (/////generation.log! (format <description> " " (%.text (:as Text name)))))] - (wrap /////directive.no_requirements)) + (in /////directive.no_requirements)) _ - (phase.throw ///.invalid_syntax [extension_name %.code inputsC+]))))] + (phase.except ///.invalid_syntax [extension_name %.code inputsC+]))))] ["Analysis" def::analysis @@ -412,10 +412,10 @@ module_id (phase.lift (archive.id current_module archive)) _ (/////directive.lift_generation (define_program archive module_id generate program programS))] - (wrap /////directive.no_requirements)) + (in /////directive.no_requirements)) _ - (phase.throw ///.invalid_syntax [extension_name %.code inputsC+])))) + (phase.except ///.invalid_syntax [extension_name %.code inputsC+])))) (def: (bundle::def expander host_analysis program anchorT,expressionT,directiveT extender) (All [anchor expression directive] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/common_lisp/common.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/common_lisp/common.lux index 7f911e3b3..ec91d1e10 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/common_lisp/common.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/common_lisp/common.lux @@ -49,7 +49,7 @@ (handler extension_name phase archive input') (#try.Failure error) - (/////.throw extension.invalid_syntax [extension_name %synthesis input])))) + (/////.except extension.invalid_syntax [extension_name %synthesis input])))) (template: (!unary function) (|>> list _.apply/* (|> (_.constant function)))) @@ -71,10 +71,10 @@ ## (monad.map ! (function (_ [chars branch]) ## (do ! ## [branchG (phase archive branch)] -## (wrap [(|> chars (list\map (|>> .int _.int (_.=/2 @input))) _.or) +## (in [(|> chars (list\map (|>> .int _.int (_.=/2 @input))) _.or) ## branchG]))) ## conditionals))] -## (wrap (_.let (list [@input inputG]) +## (in (_.let (list [@input inputG]) ## (list (list\fold (function (_ [test then] else) ## (_.if test then else)) ## elseG diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux index 9cc6c1dbc..e84d5cdf7 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux @@ -43,7 +43,7 @@ (handler extension_name phase archive input') (#try.Failure error) - (/////.throw extension.invalid_syntax [extension_name %synthesis input])))) + (/////.except extension.invalid_syntax [extension_name %synthesis input])))) ## [Procedures] ## [[Bits]] @@ -108,14 +108,14 @@ (monad.map ! (function (_ [chars branch]) (do ! [branchG (phase archive branch)] - (wrap [(list\map (|>> .int _.int) chars) - (_.return branchG)]))) + (in [(list\map (|>> .int _.int) chars) + (_.return branchG)]))) conditionals))] - (wrap (_.apply/* (_.closure (list) - (_.switch (_.the //runtime.i64_low_field inputG) - conditionalsG - (#.Some (_.return elseG)))) - (list)))))])) + (in (_.apply/* (_.closure (list) + (_.switch (_.the //runtime.i64_low_field inputG) + conditionalsG + (#.Some (_.return elseG)))) + (list)))))])) ## [Bundles] (def: lux_procs diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/js/host.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/js/host.lux index 67966efe8..8e9464e77 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/js/host.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/js/host.lux @@ -69,7 +69,7 @@ (do {! ////////phase.monad} [constructorG (phase archive constructorS) inputsG (monad.map ! (phase archive) inputsS)] - (wrap (_.new constructorG inputsG))))])) + (in (_.new constructorG inputsG))))])) (def: object::get Handler @@ -78,7 +78,7 @@ (function (_ extension phase archive [fieldS objectS]) (do ////////phase.monad [objectG (phase archive objectS)] - (wrap (_.the fieldS objectG))))])) + (in (_.the fieldS objectG))))])) (def: object::do Handler @@ -88,7 +88,7 @@ (do {! ////////phase.monad} [objectG (phase archive objectS) inputsG (monad.map ! (phase archive) inputsS)] - (wrap (_.do methodS inputsG objectG))))])) + (in (_.do methodS inputsG objectG))))])) (template [<!> <?> <unit>] [(def: <!> (Nullary Expression) (function.constant <unit>)) @@ -115,7 +115,7 @@ (custom [<s>.text (function (_ extension phase archive name) - (\ ////////phase.monad wrap (_.var name)))])) + (\ ////////phase.monad in (_.var name)))])) (def: js::apply (custom @@ -124,7 +124,7 @@ (do {! ////////phase.monad} [abstractionG (phase archive abstractionS) inputsG (monad.map ! (phase archive) inputsS)] - (wrap (_.apply/* abstractionG inputsG))))])) + (in (_.apply/* abstractionG inputsG))))])) (def: js::function (custom @@ -138,13 +138,13 @@ g!inputs (monad.map ! (function (_ _) (variable "input")) (list.repeat (.nat arity) [])) g!abstraction (variable "abstraction")] - (wrap (_.closure g!inputs - ($_ _.then - (_.define g!abstraction abstractionG) - (_.return (case (.nat arity) - 0 (_.apply/1 g!abstraction //runtime.unit) - 1 (_.apply/* g!abstraction g!inputs) - _ (_.apply/1 g!abstraction (_.array g!inputs)))))))))])) + (in (_.closure g!inputs + ($_ _.then + (_.define g!abstraction abstractionG) + (_.return (case (.nat arity) + 0 (_.apply/1 g!abstraction //runtime.unit) + 1 (_.apply/* g!abstraction g!inputs) + _ (_.apply/1 g!abstraction (_.array g!inputs)))))))))])) (def: #export bundle Bundle diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux index d71b9dbcc..eed3eb6ce 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux @@ -47,13 +47,13 @@ (-> [(Parser s) (-> Text Phase Archive s (Operation (Bytecode Any)))] Handler)) - (function (_ extension-name phase archive input) + (function (_ extension_name phase archive input) (case (<s>.run parser input) (#try.Success input') - (handler extension-name phase archive input') + (handler extension_name phase archive input') (#try.Failure error) - (/////.throw /////extension.invalid-syntax [extension-name //////synthesis.%synthesis input])))) + (/////.except /////extension.invalid_syntax [extension_name //////synthesis.%synthesis input])))) (def: $Boolean (type.class "java.lang.Boolean" (list))) (def: $Double (type.class "java.lang.Double" (list))) @@ -65,19 +65,19 @@ (def: $System (type.class "java.lang.System" (list))) (def: $Error (type.class "java.lang.Error" (list))) -(def: lux-int +(def: lux_int (Bytecode Any) ($_ _.compose _.i2l (///value.wrap type.long))) -(def: jvm-int +(def: jvm_int (Bytecode Any) ($_ _.compose (///value.unwrap type.long) _.l2i)) -(def: ensure-string +(def: ensure_string (Bytecode Any) (_.checkcast $String)) @@ -85,28 +85,28 @@ (-> (-> Label (Bytecode Any)) (Bytecode Any)) (do _.monad - [@then _.new-label - @end _.new-label] + [@then _.new_label + @end _.new_label] ($_ _.compose (bytecode @then) (_.getstatic $Boolean "FALSE" $Boolean) (_.goto @end) - (_.set-label @then) + (_.set_label @then) (_.getstatic $Boolean "TRUE" $Boolean) - (_.set-label @end) + (_.set_label @end) ))) ## TODO: Get rid of this ASAP -(def: lux::syntax-char-case! +(def: lux::syntax_char_case! (..custom [($_ <>.and <s>.any <s>.any (<>.some (<s>.tuple ($_ <>.and (<s>.tuple (<>.many <s>.i64)) <s>.any)))) - (function (_ extension-name phase archive [inputS elseS conditionalsS]) + (function (_ extension_name phase archive [inputS elseS conditionalsS]) (do {! /////.monad} - [@end ///runtime.forge-label + [@end ///runtime.forge_label inputG (phase archive inputS) elseG (phase archive elseS) conditionalsG+ (: (Operation (List [(List [S4 Label]) @@ -114,14 +114,14 @@ (monad.map ! (function (_ [chars branch]) (do ! [branchG (phase archive branch) - @branch ///runtime.forge-label] - (wrap [(list\map (function (_ char) - [(try.assumed (signed.s4 (.int char))) @branch]) - chars) - ($_ _.compose - (_.set-label @branch) - branchG - (_.goto @end))]))) + @branch ///runtime.forge_label] + (in [(list\map (function (_ char) + [(try.assumed (signed.s4 (.int char))) @branch]) + chars) + ($_ _.compose + (_.set_label @branch) + branchG + (_.goto @end))]))) conditionalsS)) #let [table (|> conditionalsG+ (list\map product.left) @@ -129,23 +129,23 @@ conditionalsG (|> conditionalsG+ (list\map product.right) (monad.seq _.monad))]] - (wrap (do _.monad - [@else _.new-label] - ($_ _.compose - inputG (///value.unwrap type.long) _.l2i - (_.lookupswitch @else table) - conditionalsG - (_.set-label @else) - elseG - (_.set-label @end) - )))))])) + (in (do _.monad + [@else _.new_label] + ($_ _.compose + inputG (///value.unwrap type.long) _.l2i + (_.lookupswitch @else table) + conditionalsG + (_.set_label @else) + elseG + (_.set_label @end) + )))))])) (def: (lux::is [referenceG sampleG]) (Binary (Bytecode Any)) ($_ _.compose referenceG sampleG - (..predicate _.if-acmpeq))) + (..predicate _.if_acmpeq))) (def: (lux::try riskyG) (Unary (Bytecode Any)) @@ -157,7 +157,7 @@ (def: bundle::lux Bundle (|> (: Bundle /////bundle.empty) - (/////bundle.install "syntax char case!" ..lux::syntax-char-case!) + (/////bundle.install "syntax char case!" ..lux::syntax_char_case!) (/////bundle.install "is" (binary ..lux::is)) (/////bundle.install "try" (unary ..lux::try)))) @@ -179,11 +179,11 @@ (Binary (Bytecode Any)) ($_ _.compose inputG (///value.unwrap type.long) - shiftG ..jvm-int + shiftG ..jvm_int <op> (///value.wrap type.long)))] - [i64::left-shift _.lshl] - [i64::right-shift _.lushr] + [i64::left_shift _.lshl] + [i64::right_shift _.lushr] ) (template [<name> <type> <op>] @@ -216,16 +216,16 @@ paramG (///value.unwrap <type>) <cmp> <reference> - (..predicate _.if-icmpeq)))] + (..predicate _.if_icmpeq)))] - [<eq> _.iconst-0] - [<lt> _.iconst-m1])] + [<eq> _.iconst_0] + [<lt> _.iconst_m1])] [i64::= i64::< type.long _.lcmp] [f64::= f64::< type.double _.dcmpg] ) -(def: (to-string class from) +(def: (to_string class from) (-> (Type Class) (Type Primitive) (Bytecode Any)) (_.invokestatic class "toString" (type.method [(list from) ..$String (list)]))) @@ -248,7 +248,7 @@ ($_ _.compose _.l2i _.i2c - (..to-string ..$Character type.char))] + (..to_string ..$Character type.char))] [f64::i64 (///value.unwrap type.double) @@ -258,11 +258,11 @@ [f64::encode (///value.unwrap type.double) - (..to-string ..$Double type.double)] + (..to_string ..$Double type.double)] [f64::decode - ..ensure-string - ///runtime.decode-frac] + ..ensure_string + ///runtime.decode_frac] ) (def: bundle::i64 @@ -272,8 +272,8 @@ (/////bundle.install "and" (binary ..i64::and)) (/////bundle.install "or" (binary ..i64::or)) (/////bundle.install "xor" (binary ..i64::xor)) - (/////bundle.install "left-shift" (binary ..i64::left-shift)) - (/////bundle.install "right-shift" (binary ..i64::right-shift)) + (/////bundle.install "left-shift" (binary ..i64::left_shift)) + (/////bundle.install "right-shift" (binary ..i64::right_shift)) (/////bundle.install "=" (binary ..i64::=)) (/////bundle.install "<" (binary ..i64::<)) (/////bundle.install "+" (binary ..i64::+)) @@ -303,67 +303,67 @@ (Unary (Bytecode Any)) ($_ _.compose inputG - ..ensure-string + ..ensure_string (_.invokevirtual ..$String "length" (type.method [(list) type.int (list)])) - ..lux-int)) + ..lux_int)) -(def: no-op (Bytecode Any) (_\wrap [])) +(def: no_op (Bytecode Any) (_\in [])) -(template [<name> <pre-subject> <pre-param> <op> <post>] +(template [<name> <pre_subject> <pre_param> <op> <post>] [(def: (<name> [paramG subjectG]) (Binary (Bytecode Any)) ($_ _.compose - subjectG <pre-subject> - paramG <pre-param> + subjectG <pre_subject> + paramG <pre_param> <op> <post>))] - [text::= ..no-op ..no-op + [text::= ..no_op ..no_op (_.invokevirtual ..$Object "equals" (type.method [(list ..$Object) type.boolean (list)])) (///value.wrap type.boolean)] - [text::< ..ensure-string ..ensure-string + [text::< ..ensure_string ..ensure_string (_.invokevirtual ..$String "compareTo" (type.method [(list ..$String) type.int (list)])) (..predicate _.iflt)] - [text::char ..ensure-string ..jvm-int + [text::char ..ensure_string ..jvm_int (_.invokevirtual ..$String "charAt" (type.method [(list type.int) type.char (list)])) - ..lux-int] + ..lux_int] ) (def: (text::concat [leftG rightG]) (Binary (Bytecode Any)) ($_ _.compose - leftG ..ensure-string - rightG ..ensure-string + leftG ..ensure_string + rightG ..ensure_string (_.invokevirtual ..$String "concat" (type.method [(list ..$String) ..$String (list)])))) (def: (text::clip [startG endG subjectG]) (Trinary (Bytecode Any)) ($_ _.compose - subjectG ..ensure-string - startG ..jvm-int - endG ..jvm-int + subjectG ..ensure_string + startG ..jvm_int + endG ..jvm_int (_.invokevirtual ..$String "substring" (type.method [(list type.int type.int) ..$String (list)])))) -(def: index-method (type.method [(list ..$String type.int) type.int (list)])) +(def: index_method (type.method [(list ..$String type.int) type.int (list)])) (def: (text::index [startG partG textG]) (Trinary (Bytecode Any)) (do _.monad - [@not-found _.new-label - @end _.new-label] + [@not_found _.new_label + @end _.new_label] ($_ _.compose - textG ..ensure-string - partG ..ensure-string - startG ..jvm-int - (_.invokevirtual ..$String "indexOf" index-method) + textG ..ensure_string + partG ..ensure_string + startG ..jvm_int + (_.invokevirtual ..$String "indexOf" index_method) _.dup - _.iconst-m1 - (_.if-icmpeq @not-found) - ..lux-int - ///runtime.some-injection + _.iconst_m1 + (_.if_icmpeq @not_found) + ..lux_int + ///runtime.some_injection (_.goto @end) - (_.set-label @not-found) + (_.set_label @not_found) _.pop - ///runtime.none-injection - (_.set-label @end)))) + ///runtime.none_injection + (_.set_label @end)))) (def: bundle::text Bundle @@ -377,14 +377,14 @@ (/////bundle.install "char" (binary ..text::char)) (/////bundle.install "clip" (trinary ..text::clip))))) -(def: string-method (type.method [(list ..$String) type.void (list)])) +(def: string_method (type.method [(list ..$String) type.void (list)])) (def: (io::log messageG) (Unary (Bytecode Any)) ($_ _.compose (_.getstatic ..$System "out" ..$PrintStream) messageG - ..ensure-string - (_.invokevirtual ..$PrintStream "println" ..string-method) + ..ensure_string + (_.invokevirtual ..$PrintStream "println" ..string_method) ///runtime.unit)) (def: (io::error messageG) @@ -393,8 +393,8 @@ (_.new ..$Error) _.dup messageG - ..ensure-string - (_.invokespecial ..$Error "<init>" ..string-method) + ..ensure_string + (_.invokespecial ..$Error "<init>" ..string_method) _.athrow)) (def: bundle::io diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux index bcab57722..9827c2480 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux @@ -34,7 +34,7 @@ [encoding ["." name]] ["_" bytecode (#+ Label Bytecode) ("#\." monad) - ["__" instruction (#+ Primitive-Array-Type)]] + ["__" instruction (#+ Primitive_Array_Type)]] ["." type (#+ Type Typed Argument) ["." category (#+ Void Value' Value Return' Return Primitive Object Array Var Parameter)] ["." box] @@ -90,60 +90,60 @@ inputG <conversion>)))] - [_.d2f conversion::double-to-float] - [_.d2i conversion::double-to-int] - [_.d2l conversion::double-to-long] - [_.f2d conversion::float-to-double] - [_.f2i conversion::float-to-int] - [_.f2l conversion::float-to-long] - [_.i2b conversion::int-to-byte] - [_.i2c conversion::int-to-char] - [_.i2d conversion::int-to-double] - [_.i2f conversion::int-to-float] - [_.i2l conversion::int-to-long] - [_.i2s conversion::int-to-short] - [_.l2d conversion::long-to-double] - [_.l2f conversion::long-to-float] - [_.l2i conversion::long-to-int] - [..l2s conversion::long-to-short] - [..l2b conversion::long-to-byte] - [..l2c conversion::long-to-char] - [_.i2b conversion::char-to-byte] - [_.i2s conversion::char-to-short] - [_.nop conversion::char-to-int] - [_.i2l conversion::char-to-long] - [_.i2l conversion::byte-to-long] - [_.i2l conversion::short-to-long] + [_.d2f conversion::double_to_float] + [_.d2i conversion::double_to_int] + [_.d2l conversion::double_to_long] + [_.f2d conversion::float_to_double] + [_.f2i conversion::float_to_int] + [_.f2l conversion::float_to_long] + [_.i2b conversion::int_to_byte] + [_.i2c conversion::int_to_char] + [_.i2d conversion::int_to_double] + [_.i2f conversion::int_to_float] + [_.i2l conversion::int_to_long] + [_.i2s conversion::int_to_short] + [_.l2d conversion::long_to_double] + [_.l2f conversion::long_to_float] + [_.l2i conversion::long_to_int] + [..l2s conversion::long_to_short] + [..l2b conversion::long_to_byte] + [..l2c conversion::long_to_char] + [_.i2b conversion::char_to_byte] + [_.i2s conversion::char_to_short] + [_.nop conversion::char_to_int] + [_.i2l conversion::char_to_long] + [_.i2l conversion::byte_to_long] + [_.i2l conversion::short_to_long] ) (def: bundle::conversion Bundle (<| (/////bundle.prefix "conversion") (|> (: Bundle /////bundle.empty) - (/////bundle.install "double-to-float" (unary conversion::double-to-float)) - (/////bundle.install "double-to-int" (unary conversion::double-to-int)) - (/////bundle.install "double-to-long" (unary conversion::double-to-long)) - (/////bundle.install "float-to-double" (unary conversion::float-to-double)) - (/////bundle.install "float-to-int" (unary conversion::float-to-int)) - (/////bundle.install "float-to-long" (unary conversion::float-to-long)) - (/////bundle.install "int-to-byte" (unary conversion::int-to-byte)) - (/////bundle.install "int-to-char" (unary conversion::int-to-char)) - (/////bundle.install "int-to-double" (unary conversion::int-to-double)) - (/////bundle.install "int-to-float" (unary conversion::int-to-float)) - (/////bundle.install "int-to-long" (unary conversion::int-to-long)) - (/////bundle.install "int-to-short" (unary conversion::int-to-short)) - (/////bundle.install "long-to-double" (unary conversion::long-to-double)) - (/////bundle.install "long-to-float" (unary conversion::long-to-float)) - (/////bundle.install "long-to-int" (unary conversion::long-to-int)) - (/////bundle.install "long-to-short" (unary conversion::long-to-short)) - (/////bundle.install "long-to-byte" (unary conversion::long-to-byte)) - (/////bundle.install "long-to-char" (unary conversion::long-to-char)) - (/////bundle.install "char-to-byte" (unary conversion::char-to-byte)) - (/////bundle.install "char-to-short" (unary conversion::char-to-short)) - (/////bundle.install "char-to-int" (unary conversion::char-to-int)) - (/////bundle.install "char-to-long" (unary conversion::char-to-long)) - (/////bundle.install "byte-to-long" (unary conversion::byte-to-long)) - (/////bundle.install "short-to-long" (unary conversion::short-to-long)) + (/////bundle.install "double-to-float" (unary conversion::double_to_float)) + (/////bundle.install "double-to-int" (unary conversion::double_to_int)) + (/////bundle.install "double-to-long" (unary conversion::double_to_long)) + (/////bundle.install "float-to-double" (unary conversion::float_to_double)) + (/////bundle.install "float-to-int" (unary conversion::float_to_int)) + (/////bundle.install "float-to-long" (unary conversion::float_to_long)) + (/////bundle.install "int-to-byte" (unary conversion::int_to_byte)) + (/////bundle.install "int-to-char" (unary conversion::int_to_char)) + (/////bundle.install "int-to-double" (unary conversion::int_to_double)) + (/////bundle.install "int-to-float" (unary conversion::int_to_float)) + (/////bundle.install "int-to-long" (unary conversion::int_to_long)) + (/////bundle.install "int-to-short" (unary conversion::int_to_short)) + (/////bundle.install "long-to-double" (unary conversion::long_to_double)) + (/////bundle.install "long-to-float" (unary conversion::long_to_float)) + (/////bundle.install "long-to-int" (unary conversion::long_to_int)) + (/////bundle.install "long-to-short" (unary conversion::long_to_short)) + (/////bundle.install "long-to-byte" (unary conversion::long_to_byte)) + (/////bundle.install "long-to-char" (unary conversion::long_to_char)) + (/////bundle.install "char-to-byte" (unary conversion::char_to_byte)) + (/////bundle.install "char-to-short" (unary conversion::char_to_short)) + (/////bundle.install "char-to-int" (unary conversion::char_to_int)) + (/////bundle.install "char-to-long" (unary conversion::char_to_long)) + (/////bundle.install "byte-to-long" (unary conversion::byte_to_long)) + (/////bundle.install "short-to-long" (unary conversion::short_to_long)) ))) (template [<name> <op>] @@ -199,42 +199,42 @@ [(def: (<name> [xG yG]) (Binary (Bytecode Any)) (do _.monad - [@then _.new-label - @end _.new-label] + [@then _.new_label + @end _.new_label] ($_ _.compose xG yG (<op> @then) falseG (_.goto @end) - (_.set-label @then) + (_.set_label @then) trueG - (_.set-label @end))))] + (_.set_label @end))))] - [int::= _.if-icmpeq] - [int::< _.if-icmplt] + [int::= _.if_icmpeq] + [int::< _.if_icmplt] - [char::= _.if-icmpeq] - [char::< _.if-icmplt] + [char::= _.if_icmpeq] + [char::< _.if_icmplt] ) (template [<name> <op> <reference>] [(def: (<name> [xG yG]) (Binary (Bytecode Any)) (do _.monad - [@then _.new-label - @end _.new-label] + [@then _.new_label + @end _.new_label] ($_ _.compose xG yG <op> (_.int (i32.i32 (.i64 <reference>))) - (_.if-icmpeq @then) + (_.if_icmpeq @then) falseG (_.goto @end) - (_.set-label @then) + (_.set_label @then) trueG - (_.set-label @end))))] + (_.set_label @end))))] [long::= _.lcmp +0] [long::< _.lcmp -1] @@ -321,7 +321,7 @@ (template [<name> <category> <parser>] [(def: #export <name> (Parser (Type <category>)) - (<t>.embed <parser> <s>.text))] + (<t>.then <parser> <s>.text))] [var Var parser.var] [class category.Class parser.class] @@ -330,133 +330,133 @@ [return Return parser.return] ) -(exception: #export (not-an-object-array {arrayJT (Type Array)}) +(exception: #export (not_an_object_array {arrayJT (Type Array)}) (exception.report ["JVM Type" (|> arrayJT type.signature signature.signature)])) -(def: #export object-array +(def: #export object_array (Parser (Type Object)) (do <>.monad - [arrayJT (<t>.embed parser.array <s>.text)] + [arrayJT (<t>.then parser.array <s>.text)] (case (parser.array? arrayJT) (#.Some elementJT) (case (parser.object? elementJT) (#.Some elementJT) - (wrap elementJT) + (in elementJT) #.None - (<>.failure (exception.construct ..not-an-object-array arrayJT))) + (<>.failure (exception.construct ..not_an_object_array arrayJT))) #.None (undefined)))) -(def: (primitive-array-length-handler jvm-primitive) +(def: (primitive_array_length_handler jvm_primitive) (-> (Type Primitive) Handler) (..custom [<s>.any - (function (_ extension-name generate archive arrayS) + (function (_ extension_name generate archive arrayS) (do //////.monad [arrayG (generate archive arrayS)] - (wrap ($_ _.compose - arrayG - (_.checkcast (type.array jvm-primitive)) - _.arraylength))))])) + (in ($_ _.compose + arrayG + (_.checkcast (type.array jvm_primitive)) + _.arraylength))))])) (def: array::length::object Handler (..custom - [($_ <>.and ..object-array <s>.any) - (function (_ extension-name generate archive [elementJT arrayS]) + [($_ <>.and ..object_array <s>.any) + (function (_ extension_name generate archive [elementJT arrayS]) (do //////.monad [arrayG (generate archive arrayS)] - (wrap ($_ _.compose - arrayG - (_.checkcast (type.array elementJT)) - _.arraylength))))])) + (in ($_ _.compose + arrayG + (_.checkcast (type.array elementJT)) + _.arraylength))))])) -(def: (new-primitive-array-handler jvm-primitive) - (-> Primitive-Array-Type Handler) +(def: (new_primitive_array_handler jvm_primitive) + (-> Primitive_Array_Type Handler) (..custom [<s>.any - (function (_ extension-name generate archive [lengthS]) + (function (_ extension_name generate archive [lengthS]) (do //////.monad [lengthG (generate archive lengthS)] - (wrap ($_ _.compose - lengthG - (_.newarray jvm-primitive)))))])) + (in ($_ _.compose + lengthG + (_.newarray jvm_primitive)))))])) (def: array::new::object Handler (..custom [($_ <>.and ..object <s>.any) - (function (_ extension-name generate archive [objectJT lengthS]) + (function (_ extension_name generate archive [objectJT lengthS]) (do //////.monad [lengthG (generate archive lengthS)] - (wrap ($_ _.compose - lengthG - (_.anewarray objectJT)))))])) + (in ($_ _.compose + lengthG + (_.anewarray objectJT)))))])) -(def: (read-primitive-array-handler jvm-primitive loadG) +(def: (read_primitive_array_handler jvm_primitive loadG) (-> (Type Primitive) (Bytecode Any) Handler) (..custom [($_ <>.and <s>.any <s>.any) - (function (_ extension-name generate archive [idxS arrayS]) + (function (_ extension_name generate archive [idxS arrayS]) (do //////.monad [arrayG (generate archive arrayS) idxG (generate archive idxS)] - (wrap ($_ _.compose - arrayG - (_.checkcast (type.array jvm-primitive)) - idxG - loadG))))])) + (in ($_ _.compose + arrayG + (_.checkcast (type.array jvm_primitive)) + idxG + loadG))))])) (def: array::read::object Handler (..custom - [($_ <>.and ..object-array <s>.any <s>.any) - (function (_ extension-name generate archive [elementJT idxS arrayS]) + [($_ <>.and ..object_array <s>.any <s>.any) + (function (_ extension_name generate archive [elementJT idxS arrayS]) (do //////.monad [arrayG (generate archive arrayS) idxG (generate archive idxS)] - (wrap ($_ _.compose - arrayG - (_.checkcast (type.array elementJT)) - idxG - _.aaload))))])) + (in ($_ _.compose + arrayG + (_.checkcast (type.array elementJT)) + idxG + _.aaload))))])) -(def: (write-primitive-array-handler jvm-primitive storeG) +(def: (write_primitive_array_handler jvm_primitive storeG) (-> (Type Primitive) (Bytecode Any) Handler) (..custom [($_ <>.and <s>.any <s>.any <s>.any) - (function (_ extension-name generate archive [idxS valueS arrayS]) + (function (_ extension_name generate archive [idxS valueS arrayS]) (do //////.monad [arrayG (generate archive arrayS) idxG (generate archive idxS) valueG (generate archive valueS)] - (wrap ($_ _.compose - arrayG - (_.checkcast (type.array jvm-primitive)) - _.dup - idxG - valueG - storeG))))])) + (in ($_ _.compose + arrayG + (_.checkcast (type.array jvm_primitive)) + _.dup + idxG + valueG + storeG))))])) (def: array::write::object Handler (..custom - [($_ <>.and ..object-array <s>.any <s>.any <s>.any) - (function (_ extension-name generate archive [elementJT idxS valueS arrayS]) + [($_ <>.and ..object_array <s>.any <s>.any <s>.any) + (function (_ extension_name generate archive [elementJT idxS valueS arrayS]) (do //////.monad [arrayG (generate archive arrayS) idxG (generate archive idxS) valueG (generate archive valueS)] - (wrap ($_ _.compose - arrayG - (_.checkcast (type.array elementJT)) - _.dup - idxG - valueG - _.aastore))))])) + (in ($_ _.compose + arrayG + (_.checkcast (type.array elementJT)) + _.dup + idxG + valueG + _.aastore))))])) (def: bundle::array Bundle @@ -464,67 +464,67 @@ (|> /////bundle.empty (dictionary.merge (<| (/////bundle.prefix "length") (|> /////bundle.empty - (/////bundle.install (reflection.reflection reflection.boolean) (primitive-array-length-handler type.boolean)) - (/////bundle.install (reflection.reflection reflection.byte) (primitive-array-length-handler type.byte)) - (/////bundle.install (reflection.reflection reflection.short) (primitive-array-length-handler type.short)) - (/////bundle.install (reflection.reflection reflection.int) (primitive-array-length-handler type.int)) - (/////bundle.install (reflection.reflection reflection.long) (primitive-array-length-handler type.long)) - (/////bundle.install (reflection.reflection reflection.float) (primitive-array-length-handler type.float)) - (/////bundle.install (reflection.reflection reflection.double) (primitive-array-length-handler type.double)) - (/////bundle.install (reflection.reflection reflection.char) (primitive-array-length-handler type.char)) + (/////bundle.install (reflection.reflection reflection.boolean) (primitive_array_length_handler type.boolean)) + (/////bundle.install (reflection.reflection reflection.byte) (primitive_array_length_handler type.byte)) + (/////bundle.install (reflection.reflection reflection.short) (primitive_array_length_handler type.short)) + (/////bundle.install (reflection.reflection reflection.int) (primitive_array_length_handler type.int)) + (/////bundle.install (reflection.reflection reflection.long) (primitive_array_length_handler type.long)) + (/////bundle.install (reflection.reflection reflection.float) (primitive_array_length_handler type.float)) + (/////bundle.install (reflection.reflection reflection.double) (primitive_array_length_handler type.double)) + (/////bundle.install (reflection.reflection reflection.char) (primitive_array_length_handler type.char)) (/////bundle.install "object" array::length::object)))) (dictionary.merge (<| (/////bundle.prefix "new") (|> /////bundle.empty - (/////bundle.install (reflection.reflection reflection.boolean) (new-primitive-array-handler __.t-boolean)) - (/////bundle.install (reflection.reflection reflection.byte) (new-primitive-array-handler __.t-byte)) - (/////bundle.install (reflection.reflection reflection.short) (new-primitive-array-handler __.t-short)) - (/////bundle.install (reflection.reflection reflection.int) (new-primitive-array-handler __.t-int)) - (/////bundle.install (reflection.reflection reflection.long) (new-primitive-array-handler __.t-long)) - (/////bundle.install (reflection.reflection reflection.float) (new-primitive-array-handler __.t-float)) - (/////bundle.install (reflection.reflection reflection.double) (new-primitive-array-handler __.t-double)) - (/////bundle.install (reflection.reflection reflection.char) (new-primitive-array-handler __.t-char)) + (/////bundle.install (reflection.reflection reflection.boolean) (new_primitive_array_handler __.t_boolean)) + (/////bundle.install (reflection.reflection reflection.byte) (new_primitive_array_handler __.t_byte)) + (/////bundle.install (reflection.reflection reflection.short) (new_primitive_array_handler __.t_short)) + (/////bundle.install (reflection.reflection reflection.int) (new_primitive_array_handler __.t_int)) + (/////bundle.install (reflection.reflection reflection.long) (new_primitive_array_handler __.t_long)) + (/////bundle.install (reflection.reflection reflection.float) (new_primitive_array_handler __.t_float)) + (/////bundle.install (reflection.reflection reflection.double) (new_primitive_array_handler __.t_double)) + (/////bundle.install (reflection.reflection reflection.char) (new_primitive_array_handler __.t_char)) (/////bundle.install "object" array::new::object)))) (dictionary.merge (<| (/////bundle.prefix "read") (|> /////bundle.empty - (/////bundle.install (reflection.reflection reflection.boolean) (read-primitive-array-handler type.boolean _.baload)) - (/////bundle.install (reflection.reflection reflection.byte) (read-primitive-array-handler type.byte _.baload)) - (/////bundle.install (reflection.reflection reflection.short) (read-primitive-array-handler type.short _.saload)) - (/////bundle.install (reflection.reflection reflection.int) (read-primitive-array-handler type.int _.iaload)) - (/////bundle.install (reflection.reflection reflection.long) (read-primitive-array-handler type.long _.laload)) - (/////bundle.install (reflection.reflection reflection.float) (read-primitive-array-handler type.float _.faload)) - (/////bundle.install (reflection.reflection reflection.double) (read-primitive-array-handler type.double _.daload)) - (/////bundle.install (reflection.reflection reflection.char) (read-primitive-array-handler type.char _.caload)) + (/////bundle.install (reflection.reflection reflection.boolean) (read_primitive_array_handler type.boolean _.baload)) + (/////bundle.install (reflection.reflection reflection.byte) (read_primitive_array_handler type.byte _.baload)) + (/////bundle.install (reflection.reflection reflection.short) (read_primitive_array_handler type.short _.saload)) + (/////bundle.install (reflection.reflection reflection.int) (read_primitive_array_handler type.int _.iaload)) + (/////bundle.install (reflection.reflection reflection.long) (read_primitive_array_handler type.long _.laload)) + (/////bundle.install (reflection.reflection reflection.float) (read_primitive_array_handler type.float _.faload)) + (/////bundle.install (reflection.reflection reflection.double) (read_primitive_array_handler type.double _.daload)) + (/////bundle.install (reflection.reflection reflection.char) (read_primitive_array_handler type.char _.caload)) (/////bundle.install "object" array::read::object)))) (dictionary.merge (<| (/////bundle.prefix "write") (|> /////bundle.empty - (/////bundle.install (reflection.reflection reflection.boolean) (write-primitive-array-handler type.boolean _.bastore)) - (/////bundle.install (reflection.reflection reflection.byte) (write-primitive-array-handler type.byte _.bastore)) - (/////bundle.install (reflection.reflection reflection.short) (write-primitive-array-handler type.short _.sastore)) - (/////bundle.install (reflection.reflection reflection.int) (write-primitive-array-handler type.int _.iastore)) - (/////bundle.install (reflection.reflection reflection.long) (write-primitive-array-handler type.long _.lastore)) - (/////bundle.install (reflection.reflection reflection.float) (write-primitive-array-handler type.float _.fastore)) - (/////bundle.install (reflection.reflection reflection.double) (write-primitive-array-handler type.double _.dastore)) - (/////bundle.install (reflection.reflection reflection.char) (write-primitive-array-handler type.char _.castore)) + (/////bundle.install (reflection.reflection reflection.boolean) (write_primitive_array_handler type.boolean _.bastore)) + (/////bundle.install (reflection.reflection reflection.byte) (write_primitive_array_handler type.byte _.bastore)) + (/////bundle.install (reflection.reflection reflection.short) (write_primitive_array_handler type.short _.sastore)) + (/////bundle.install (reflection.reflection reflection.int) (write_primitive_array_handler type.int _.iastore)) + (/////bundle.install (reflection.reflection reflection.long) (write_primitive_array_handler type.long _.lastore)) + (/////bundle.install (reflection.reflection reflection.float) (write_primitive_array_handler type.float _.fastore)) + (/////bundle.install (reflection.reflection reflection.double) (write_primitive_array_handler type.double _.dastore)) + (/////bundle.install (reflection.reflection reflection.char) (write_primitive_array_handler type.char _.castore)) (/////bundle.install "object" array::write::object)))) ))) (def: (object::null _) (Nullary (Bytecode Any)) - _.aconst-null) + _.aconst_null) (def: (object::null? objectG) (Unary (Bytecode Any)) (do _.monad - [@then _.new-label - @end _.new-label] + [@then _.new_label + @end _.new_label] ($_ _.compose objectG (_.ifnull @then) ..falseG (_.goto @end) - (_.set-label @then) + (_.set_label @then) ..trueG - (_.set-label @end)))) + (_.set_label @end)))) (def: (object::synchronized [monitorG exprG]) (Binary (Bytecode Any)) @@ -549,24 +549,24 @@ Handler (..custom [<s>.text - (function (_ extension-name generate archive [class]) + (function (_ extension_name generate archive [class]) (do //////.monad [] - (wrap ($_ _.compose - (_.string class) - (_.invokestatic ..$Class "forName" (type.method [(list ..$String) ..$Class (list)]))))))])) + (in ($_ _.compose + (_.string class) + (_.invokestatic ..$Class "forName" (type.method [(list ..$String) ..$Class (list)]))))))])) (def: object::instance? Handler (..custom [($_ <>.and <s>.text <s>.any) - (function (_ extension-name generate archive [class objectS]) + (function (_ extension_name generate archive [class objectS]) (do //////.monad [objectG (generate archive objectS)] - (wrap ($_ _.compose - objectG - (_.instanceof (type.class class (list))) - (_.invokestatic ..$Boolean "valueOf" (type.method [(list type.boolean) ..$Boolean (list)]))))))])) + (in ($_ _.compose + objectG + (_.instanceof (type.class class (list))) + (_.invokestatic ..$Boolean "valueOf" (type.method [(list type.boolean) ..$Boolean (list)]))))))])) (def: reflection (All [category] @@ -577,39 +577,39 @@ Handler (..custom [($_ <>.and <s>.text <s>.text <s>.any) - (function (_ extension-name generate archive [from to valueS]) + (function (_ extension_name generate archive [from to valueS]) (do //////.monad [valueG (generate archive valueS)] - (wrap (`` (cond (~~ (template [<object> <type> <unwrap>] - [(and (text\= (..reflection <type>) - from) - (text\= <object> - to)) - (let [$<object> (type.class <object> (list))] - ($_ _.compose - valueG - (_.invokestatic $<object> "valueOf" (type.method [(list <type>) $<object> (list)])))) - - (and (text\= <object> - from) - (text\= (..reflection <type>) - to)) - (let [$<object> (type.class <object> (list))] - ($_ _.compose - valueG - (_.checkcast $<object>) - (_.invokevirtual $<object> <unwrap> (type.method [(list) <type> (list)]))))] - - [box.boolean type.boolean "booleanValue"] - [box.byte type.byte "byteValue"] - [box.short type.short "shortValue"] - [box.int type.int "intValue"] - [box.long type.long "longValue"] - [box.float type.float "floatValue"] - [box.double type.double "doubleValue"] - [box.char type.char "charValue"])) - ## else - valueG)))))])) + (in (`` (cond (~~ (template [<object> <type> <unwrap>] + [(and (text\= (..reflection <type>) + from) + (text\= <object> + to)) + (let [$<object> (type.class <object> (list))] + ($_ _.compose + valueG + (_.invokestatic $<object> "valueOf" (type.method [(list <type>) $<object> (list)])))) + + (and (text\= <object> + from) + (text\= (..reflection <type>) + to)) + (let [$<object> (type.class <object> (list))] + ($_ _.compose + valueG + (_.checkcast $<object>) + (_.invokevirtual $<object> <unwrap> (type.method [(list) <type> (list)]))))] + + [box.boolean type.boolean "booleanValue"] + [box.byte type.byte "byteValue"] + [box.short type.short "shortValue"] + [box.int type.int "intValue"] + [box.long type.long "longValue"] + [box.float type.float "floatValue"] + [box.double type.double "doubleValue"] + [box.char type.char "charValue"])) + ## else + valueG)))))])) (def: bundle::object Bundle @@ -634,21 +634,21 @@ [(reflection.reflection reflection.float) type.float] [(reflection.reflection reflection.double) type.double] [(reflection.reflection reflection.char) type.char]) - (dictionary.from-list text.hash))) + (dictionary.from_list text.hash))) (def: get::static Handler (..custom [($_ <>.and <s>.text <s>.text <s>.text) - (function (_ extension-name generate archive [class field unboxed]) + (function (_ extension_name generate archive [class field unboxed]) (do //////.monad [#let [$class (type.class class (list))]] (case (dictionary.get unboxed ..primitives) (#.Some primitive) - (wrap (_.getstatic $class field primitive)) + (in (_.getstatic $class field primitive)) #.None - (wrap (_.getstatic $class field (type.class unboxed (list)))))))])) + (in (_.getstatic $class field (type.class unboxed (list)))))))])) (def: unitG (_.string //////synthesis.unit)) @@ -656,29 +656,29 @@ Handler (..custom [($_ <>.and <s>.text <s>.text <s>.text <s>.any) - (function (_ extension-name generate archive [class field unboxed valueS]) + (function (_ extension_name generate archive [class field unboxed valueS]) (do //////.monad [valueG (generate archive valueS) #let [$class (type.class class (list))]] (case (dictionary.get unboxed ..primitives) (#.Some primitive) - (wrap ($_ _.compose - valueG - (_.putstatic $class field primitive) - ..unitG)) + (in ($_ _.compose + valueG + (_.putstatic $class field primitive) + ..unitG)) #.None - (wrap ($_ _.compose - valueG - (_.checkcast $class) - (_.putstatic $class field $class) - ..unitG)))))])) + (in ($_ _.compose + valueG + (_.checkcast $class) + (_.putstatic $class field $class) + ..unitG)))))])) (def: get::virtual Handler (..custom [($_ <>.and <s>.text <s>.text <s>.text <s>.any) - (function (_ extension-name generate archive [class field unboxed objectS]) + (function (_ extension_name generate archive [class field unboxed objectS]) (do //////.monad [objectG (generate archive objectS) #let [$class (type.class class (list)) @@ -688,16 +688,16 @@ #.None (_.getfield $class field (type.class unboxed (list))))]] - (wrap ($_ _.compose - objectG - (_.checkcast $class) - getG))))])) + (in ($_ _.compose + objectG + (_.checkcast $class) + getG))))])) (def: put::virtual Handler (..custom [($_ <>.and <s>.text <s>.text <s>.text <s>.any <s>.any) - (function (_ extension-name generate archive [class field unboxed valueS objectS]) + (function (_ extension_name generate archive [class field unboxed valueS objectS]) (do //////.monad [valueG (generate archive valueS) objectG (generate archive objectS) @@ -711,12 +711,12 @@ ($_ _.compose (_.checkcast $unboxed) (_.putfield $class field $unboxed))))]] - (wrap ($_ _.compose - objectG - (_.checkcast $class) - _.dup - valueG - putG))))])) + (in ($_ _.compose + objectG + (_.checkcast $class) + _.dup + valueG + putG))))])) (type: Input (Typed Synthesis)) @@ -724,55 +724,55 @@ (Parser Input) (<s>.tuple (<>.and ..value <s>.any))) -(def: (generate-input generate archive [valueT valueS]) +(def: (generate_input generate archive [valueT valueS]) (-> Phase Archive Input (Operation (Typed (Bytecode Any)))) (do //////.monad [valueG (generate archive valueS)] (case (type.primitive? valueT) (#.Right valueT) - (wrap [valueT valueG]) + (in [valueT valueG]) (#.Left valueT) - (wrap [valueT ($_ _.compose - valueG - (_.checkcast valueT))])))) + (in [valueT ($_ _.compose + valueG + (_.checkcast valueT))])))) -(def: (prepare-output outputT) +(def: (prepare_output outputT) (-> (Type Return) (Bytecode Any)) (case (type.void? outputT) (#.Right outputT) ..unitG (#.Left outputT) - (\ _.monad wrap []))) + (\ _.monad in []))) (def: invoke::static Handler (..custom [($_ <>.and ..class <s>.text ..return (<>.some ..input)) - (function (_ extension-name generate archive [class method outputT inputsTS]) + (function (_ extension_name generate archive [class method outputT inputsTS]) (do {! //////.monad} - [inputsTG (monad.map ! (generate-input generate archive) inputsTS)] - (wrap ($_ _.compose - (monad.map _.monad product.right inputsTG) - (_.invokestatic class method (type.method [(list\map product.left inputsTG) outputT (list)])) - (prepare-output outputT)))))])) + [inputsTG (monad.map ! (generate_input generate archive) inputsTS)] + (in ($_ _.compose + (monad.map _.monad product.right inputsTG) + (_.invokestatic class method (type.method [(list\map product.left inputsTG) outputT (list)])) + (prepare_output outputT)))))])) (template [<name> <invoke>] [(def: <name> Handler (..custom [($_ <>.and ..class <s>.text ..return <s>.any (<>.some ..input)) - (function (_ extension-name generate archive [class method outputT objectS inputsTS]) + (function (_ extension_name generate archive [class method outputT objectS inputsTS]) (do {! //////.monad} [objectG (generate archive objectS) - inputsTG (monad.map ! (generate-input generate archive) inputsTS)] - (wrap ($_ _.compose - objectG - (_.checkcast class) - (monad.map _.monad product.right inputsTG) - (<invoke> class method (type.method [(list\map product.left inputsTG) outputT (list)])) - (prepare-output outputT)))))]))] + inputsTG (monad.map ! (generate_input generate archive) inputsTS)] + (in ($_ _.compose + objectG + (_.checkcast class) + (monad.map _.monad product.right inputsTG) + (<invoke> class method (type.method [(list\map product.left inputsTG) outputT (list)])) + (prepare_output outputT)))))]))] [invoke::virtual _.invokevirtual] [invoke::special _.invokespecial] @@ -783,14 +783,14 @@ Handler (..custom [($_ <>.and ..class (<>.some ..input)) - (function (_ extension-name generate archive [class inputsTS]) + (function (_ extension_name generate archive [class inputsTS]) (do {! //////.monad} - [inputsTG (monad.map ! (generate-input generate archive) inputsTS)] - (wrap ($_ _.compose - (_.new class) - _.dup - (monad.map _.monad product.right inputsTG) - (_.invokespecial class "<init>" (type.method [(list\map product.left inputsTG) type.void (list)]))))))])) + [inputsTG (monad.map ! (generate_input generate archive) inputsTS)] + (in ($_ _.compose + (_.new class) + _.dup + (monad.map _.monad product.right inputsTG) + (_.invokespecial class "<init>" (type.method [(list\map product.left inputsTG) type.void (list)]))))))])) (def: bundle::member Bundle @@ -813,40 +813,40 @@ (/////bundle.install "constructor" invoke::constructor)))) ))) -(def: annotation-parameter - (Parser (/.Annotation-Parameter Synthesis)) +(def: annotation_parameter + (Parser (/.Annotation_Parameter Synthesis)) (<s>.tuple (<>.and <s>.text <s>.any))) (def: annotation (Parser (/.Annotation Synthesis)) - (<s>.tuple (<>.and <s>.text (<>.some ..annotation-parameter)))) + (<s>.tuple (<>.and <s>.text (<>.some ..annotation_parameter)))) (def: argument (Parser Argument) (<s>.tuple (<>.and <s>.text ..value))) -(def: overriden-method-definition - (Parser [(Environment Synthesis) (/.Overriden-Method Synthesis)]) +(def: overriden_method_definition + (Parser [(Environment Synthesis) (/.Overriden_Method Synthesis)]) (<s>.tuple (do <>.monad - [_ (<s>.text! /.overriden-tag) + [_ (<s>.text! /.overriden_tag) ownerT ..class name <s>.text - strict-fp? <s>.bit + strict_fp? <s>.bit annotations (<s>.tuple (<>.some ..annotation)) vars (<s>.tuple (<>.some ..var)) - self-name <s>.text + self_name <s>.text arguments (<s>.tuple (<>.some ..argument)) returnT ..return exceptionsT (<s>.tuple (<>.some ..class)) [environment body] (<s>.function 1 (<s>.tuple <s>.any))] - (wrap [environment - [ownerT name - strict-fp? annotations vars - self-name arguments returnT exceptionsT - body]])))) + (in [environment + [ownerT name + strict_fp? annotations vars + self_name arguments returnT exceptionsT + body]])))) -(def: (normalize-path normalize) +(def: (normalize_path normalize) (-> (-> Synthesis Synthesis) (-> Path Path)) (function (recur path) @@ -870,7 +870,7 @@ _ (undefined)))) -(def: (normalize-method-body mapping) +(def: (normalize_method_body mapping) (-> (Dictionary Variable Variable) Synthesis Synthesis) (function (recur body) (case body @@ -893,7 +893,7 @@ //////synthesis.variable) (^ (//////synthesis.branch/case [inputS pathS])) - (//////synthesis.branch/case [(recur inputS) (normalize-path recur pathS)]) + (//////synthesis.branch/case [(recur inputS) (normalize_path recur pathS)]) (^ (//////synthesis.branch/let [inputS register outputS])) (//////synthesis.branch/let [(recur inputS) register (recur outputS)]) @@ -933,40 +933,40 @@ (def: $Object (type.class "java.lang.Object" (list))) -(def: (anonymous-init-method env) +(def: (anonymous_init_method env) (-> (Environment Synthesis) (Type category.Method)) (type.method [(list.repeat (list.size env) ..$Object) type.void (list)])) -(def: (with-anonymous-init class env super-class inputsTG) +(def: (with_anonymous_init class env super_class inputsTG) (-> (Type category.Class) (Environment Synthesis) (Type category.Class) (List (Typed (Bytecode Any))) (Resource Method)) - (let [store-capturedG (|> env + (let [store_capturedG (|> env list.size list.indices (monad.map _.monad (.function (_ register) ($_ _.compose (_.aload 0) (_.aload (inc register)) - (_.putfield class (///reference.foreign-name register) $Object)))))] - (method.method method.public "<init>" (anonymous-init-method env) + (_.putfield class (///reference.foreign_name register) $Object)))))] + (method.method method.public "<init>" (anonymous_init_method env) (list) (#.Some ($_ _.compose (_.aload 0) (monad.map _.monad product.right inputsTG) - (_.invokespecial super-class "<init>" (type.method [(list\map product.left inputsTG) type.void (list)])) - store-capturedG + (_.invokespecial super_class "<init>" (type.method [(list\map product.left inputsTG) type.void (list)])) + store_capturedG _.return))))) -(def: (anonymous-instance generate archive class env) +(def: (anonymous_instance generate archive class env) (-> Phase Archive (Type category.Class) (Environment Synthesis) (Operation (Bytecode Any))) (do {! //////.monad} [captureG+ (monad.map ! (generate archive) env)] - (wrap ($_ _.compose - (_.new class) - _.dup - (monad.seq _.monad captureG+) - (_.invokespecial class "<init>" (anonymous-init-method env)))))) + (in ($_ _.compose + (_.new class) + _.dup + (monad.seq _.monad captureG+) + (_.invokespecial class "<init>" (anonymous_init_method env)))))) (def: (returnG returnT) (-> (Type Return) (Bytecode Any)) @@ -1005,83 +1005,83 @@ ..class (<s>.tuple (<>.some ..class)) (<s>.tuple (<>.some ..input)) - (<s>.tuple (<>.some ..overriden-method-definition))) - (function (_ extension-name generate archive [super-class super-interfaces + (<s>.tuple (<>.some ..overriden_method_definition))) + (function (_ extension_name generate archive [super_class super_interfaces inputsTS - overriden-methods]) + overriden_methods]) (do {! //////.monad} - [[context _] (//////generation.with-new-context archive (wrap [])) - #let [[module-id artifact-id] context - anonymous-class-name (///runtime.class-name context) - class (type.class anonymous-class-name (list)) - total-environment (|> overriden-methods + [[context _] (//////generation.with_new_context archive (in [])) + #let [[module_id artifact_id] context + anonymous_class_name (///runtime.class_name context) + class (type.class anonymous_class_name (list)) + total_environment (|> overriden_methods ## Get all the environments. (list\map product.left) ## Combine them. list\join ## Remove duplicates. - (set.from-list //////synthesis.hash) + (set.from_list //////synthesis.hash) set.to_list) - global-mapping (|> total-environment + global_mapping (|> total_environment ## Give them names as "foreign" variables. list.enumeration (list\map (function (_ [id capture]) [capture (#//////variable.Foreign id)])) - (dictionary.from-list //////variable.hash)) - normalized-methods (list\map (function (_ [environment + (dictionary.from_list //////variable.hash)) + normalized_methods (list\map (function (_ [environment [ownerT name - strict-fp? annotations vars - self-name arguments returnT exceptionsT + strict_fp? annotations vars + self_name arguments returnT exceptionsT body]]) - (let [local-mapping (|> environment + (let [local_mapping (|> environment list.enumeration - (list\map (function (_ [foreign-id capture]) - [(#//////variable.Foreign foreign-id) - (|> global-mapping + (list\map (function (_ [foreign_id capture]) + [(#//////variable.Foreign foreign_id) + (|> global_mapping (dictionary.get capture) maybe.assume)])) - (dictionary.from-list //////variable.hash))] + (dictionary.from_list //////variable.hash))] [ownerT name - strict-fp? annotations vars - self-name arguments returnT exceptionsT - (normalize-method-body local-mapping body)])) - overriden-methods)] - inputsTI (monad.map ! (generate-input generate archive) inputsTS) - method-definitions (monad.map ! (function (_ [ownerT name - strict-fp? annotations vars - self-name arguments returnT exceptionsT + strict_fp? annotations vars + self_name arguments returnT exceptionsT + (normalize_method_body local_mapping body)])) + overriden_methods)] + inputsTI (monad.map ! (generate_input generate archive) inputsTS) + method_definitions (monad.map ! (function (_ [ownerT name + strict_fp? annotations vars + self_name arguments returnT exceptionsT bodyS]) (do ! - [bodyG (//////generation.with-context artifact-id - (generate archive bodyS))] - (wrap (method.method ($_ modifier\compose - method.public - method.final - (if strict-fp? - method.strict - modifier\identity)) - name - (type.method [(list\map product.right arguments) - returnT - exceptionsT]) - (list) - (#.Some ($_ _.compose - bodyG - (returnG returnT))))))) - normalized-methods) + [bodyG (//////generation.with_context artifact_id + (generate archive bodyS))] + (in (method.method ($_ modifier\compose + method.public + method.final + (if strict_fp? + method.strict + modifier\identity)) + name + (type.method [(list\map product.right arguments) + returnT + exceptionsT]) + (list) + (#.Some ($_ _.compose + bodyG + (returnG returnT))))))) + normalized_methods) bytecode (<| (\ ! map (format.run class.writer)) //////.lift (class.class version.v6_0 ($_ modifier\compose class.public class.final) - (name.internal anonymous-class-name) - (name.internal (..reflection super-class)) - (list\map (|>> ..reflection name.internal) super-interfaces) - (foreign.variables total-environment) - (list& (..with-anonymous-init class total-environment super-class inputsTI) - method-definitions) + (name.internal anonymous_class_name) + (name.internal (..reflection super_class)) + (list\map (|>> ..reflection name.internal) super_interfaces) + (foreign.variables total_environment) + (list& (..with_anonymous_init class total_environment super_class inputsTI) + method_definitions) (row.row))) - _ (//////generation.execute! [anonymous-class-name bytecode]) - _ (//////generation.save! (%.nat artifact-id) [anonymous-class-name bytecode])] - (anonymous-instance generate archive class total-environment)))])) + _ (//////generation.execute! [anonymous_class_name bytecode]) + _ (//////generation.save! (%.nat artifact_id) [anonymous_class_name bytecode])] + (anonymous_instance generate archive class total_environment)))])) (def: bundle::class Bundle diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/lua/common.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/lua/common.lux index b31bf5610..e8022f806 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/lua/common.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/lua/common.lux @@ -46,7 +46,7 @@ (handler extension_name phase archive input') (#try.Failure error) - (/////.throw extension.invalid_syntax [extension_name %synthesis input])))) + (/////.except extension.invalid_syntax [extension_name %synthesis input])))) (template: (!unary function) (|>> list _.apply/* (|> (_.var function)))) @@ -68,21 +68,21 @@ (monad.map ! (function (_ [chars branch]) (do ! [branchG (phase archive branch)] - (wrap [(|> chars - (list\map (|>> .int _.int (_.= @input))) - (list\fold (function (_ clause total) - (if (is? _.nil total) - clause - (_.or clause total))) - _.nil)) - branchG]))) + (in [(|> chars + (list\map (|>> .int _.int (_.= @input))) + (list\fold (function (_ clause total) + (if (is? _.nil total) + clause + (_.or clause total))) + _.nil)) + branchG]))) conditionals)) #let [closure (_.closure (list @input) (list\fold (function (_ [test then] else) (_.if test (_.return then) else)) (_.return elseG) conditionalsG))]] - (wrap (_.apply/1 closure inputG))))])) + (in (_.apply/1 closure inputG))))])) (def: lux_procs Bundle diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/lua/host.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/lua/host.lux index 1bb7d771c..35d895177 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/lua/host.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/lua/host.lux @@ -71,7 +71,7 @@ (function (_ extension phase archive [fieldS objectS]) (do ////////phase.monad [objectG (phase archive objectS)] - (wrap (_.the fieldS objectG))))])) + (in (_.the fieldS objectG))))])) (def: object::do Handler @@ -81,7 +81,7 @@ (do {! ////////phase.monad} [objectG (phase archive objectS) inputsG (monad.map ! (phase archive) inputsS)] - (wrap (_.do methodS inputsG objectG))))])) + (in (_.do methodS inputsG objectG))))])) (template [<!> <?> <unit>] [(def: <!> (Nullary Expression) (function.constant <unit>)) @@ -109,11 +109,11 @@ (function (_ extension phase archive inputS) (do {! ////////phase.monad} [inputG (phase archive inputS)] - (wrap (_.apply/1 (<| (_.closure (list $input)) - (_.return (|> (_.var "string.byte") - (_.apply/* (list $input (_.int +1) (_.length $input))) - (_.apply/1 (_.var "table.pack"))))) - inputG))))])) + (in (_.apply/1 (<| (_.closure (list $input)) + (_.return (|> (_.var "string.byte") + (_.apply/* (list $input (_.int +1) (_.length $input))) + (_.apply/1 (_.var "table.pack"))))) + inputG))))])) (def: utf8::decode (custom @@ -121,9 +121,9 @@ (function (_ extension phase archive inputS) (do {! ////////phase.monad} [inputG (phase archive inputS)] - (wrap (|> inputG - (_.apply/1 (_.var "table.unpack")) - (_.apply/1 (_.var "string.char"))))))])) + (in (|> inputG + (_.apply/1 (_.var "table.unpack")) + (_.apply/1 (_.var "string.char"))))))])) (def: utf8 Bundle @@ -137,7 +137,7 @@ (custom [<s>.text (function (_ extension phase archive name) - (\ ////////phase.monad wrap (_.var name)))])) + (\ ////////phase.monad in (_.var name)))])) (def: lua::apply (custom @@ -146,7 +146,7 @@ (do {! ////////phase.monad} [abstractionG (phase archive abstractionS) inputsG (monad.map ! (phase archive) inputsS)] - (wrap (_.apply/* inputsG abstractionG))))])) + (in (_.apply/* inputsG abstractionG))))])) (def: lua::power (custom @@ -155,13 +155,13 @@ (do {! ////////phase.monad} [powerG (phase archive powerS) baseG (phase archive baseS)] - (wrap (_.^ powerG baseG))))])) + (in (_.^ powerG baseG))))])) (def: lua::import (custom [<s>.text (function (_ extension phase archive module) - (\ ////////phase.monad wrap + (\ ////////phase.monad in (_.require/1 (_.string module))))])) (def: lua::function @@ -176,12 +176,12 @@ g!inputs (monad.map ! (function (_ _) (variable "input")) (list.repeat (.nat arity) []))] - (wrap (<| (_.closure g!inputs) - _.statement - (case (.nat arity) - 0 (_.apply/1 abstractionG //runtime.unit) - 1 (_.apply/* g!inputs abstractionG) - _ (_.apply/1 abstractionG (_.array g!inputs)))))))])) + (in (<| (_.closure g!inputs) + _.statement + (case (.nat arity) + 0 (_.apply/1 abstractionG //runtime.unit) + 1 (_.apply/* g!inputs abstractionG) + _ (_.apply/1 abstractionG (_.array g!inputs)))))))])) (def: #export bundle Bundle diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/php/common.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/php/common.lux index aa07cbe9f..519ed6563 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/php/common.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/php/common.lux @@ -49,7 +49,7 @@ (handler extension_name phase archive input') (#try.Failure error) - (/////.throw extension.invalid_syntax [extension_name %synthesis input])))) + (/////.except extension.invalid_syntax [extension_name %synthesis input])))) (template: (!unary function) (|>> list _.apply/* (|> (_.constant function)))) @@ -72,14 +72,14 @@ (monad.map ! (function (_ [chars branch]) (do ! [branchG (phase archive branch)] - (wrap [(|> chars - (list\map (|>> .int _.int (_.=== @input))) - (list\fold (function (_ clause total) - (if (is? _.null total) - clause - (_.or clause total))) - _.null)) - branchG]))) + (in [(|> chars + (list\map (|>> .int _.int (_.=== @input))) + (list\fold (function (_ clause total) + (if (is? _.null total) + clause + (_.or clause total))) + _.null)) + branchG]))) conditionals)) #let [foreigns (|> conditionals (list\map (|>> product.right synthesis.path/then //case.dependencies)) @@ -95,7 +95,7 @@ conditionalsG))] _ (generation.execute! directive) _ (generation.save! context_artifact directive)] - (wrap (_.apply/* (list& inputG foreigns) @expression))))])) + (in (_.apply/* (list& inputG foreigns) @expression))))])) (def: lux_procs Bundle diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/php/host.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/php/host.lux index ab01b5938..a8ef44fc8 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/php/host.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/php/host.lux @@ -66,7 +66,7 @@ (function (_ extension phase archive [constructor inputsS]) (do {! ////////phase.monad} [inputsG (monad.map ! (phase archive) inputsS)] - (wrap (_.new (_.constant constructor) inputsG))))])) + (in (_.new (_.constant constructor) inputsG))))])) (def: object::get Handler @@ -75,7 +75,7 @@ (function (_ extension phase archive [fieldS objectS]) (do ////////phase.monad [objectG (phase archive objectS)] - (wrap (_.the fieldS objectG))))])) + (in (_.the fieldS objectG))))])) (def: object::do Handler @@ -85,7 +85,7 @@ (do {! ////////phase.monad} [objectG (phase archive objectS) inputsG (monad.map ! (phase archive) inputsS)] - (wrap (_.do methodS inputsG objectG))))])) + (in (_.do methodS inputsG objectG))))])) (template [<!> <?> <unit>] [(def: <!> (Nullary Expression) (function.constant <unit>)) @@ -109,7 +109,7 @@ (custom [<s>.text (function (_ extension phase archive name) - (\ ////////phase.monad wrap (_.constant name)))])) + (\ ////////phase.monad in (_.constant name)))])) (def: php::apply (custom @@ -118,7 +118,7 @@ (do {! ////////phase.monad} [abstractionG (phase archive abstractionS) inputsG (monad.map ! (phase archive) inputsS)] - (wrap (_.apply/* inputsG abstractionG))))])) + (in (_.apply/* inputsG abstractionG))))])) (def: php::pack (custom @@ -127,7 +127,7 @@ (do {! ////////phase.monad} [formatG (phase archive formatS) dataG (phase archive dataS)] - (wrap (_.pack/2 [formatG (_.splat dataG)]))))])) + (in (_.pack/2 [formatG (_.splat dataG)]))))])) (def: #export bundle Bundle diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux index da9ab4a4b..d9c7fe72f 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux @@ -46,7 +46,7 @@ (handler extension_name phase archive input') (#try.Failure error) - (/////.throw extension.invalid_syntax [extension_name %synthesis input])))) + (/////.except extension.invalid_syntax [extension_name %synthesis input])))) ## TODO: Get rid of this ASAP (def: lux::syntax_char_case! @@ -66,21 +66,21 @@ (monad.map ! (function (_ [chars branch]) (do ! [branchG (phase archive branch)] - (wrap [(|> chars - (list\map (|>> .int _.int (_.= @input))) - (list\fold (function (_ clause total) - (if (is? _.none total) - clause - (_.or clause total))) - _.none)) - branchG]))) + (in [(|> chars + (list\map (|>> .int _.int (_.= @input))) + (list\fold (function (_ clause total) + (if (is? _.none total) + clause + (_.or clause total))) + _.none)) + branchG]))) conditionals)) #let [closure (_.lambda (list @input) (list\fold (function (_ [test then] else) (_.? test then else)) elseG conditionalsG))]] - (wrap (_.apply/* closure (list inputG)))))])) + (in (_.apply/* closure (list inputG)))))])) (def: lux_procs Bundle diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/host.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/host.lux index 6612cda07..a9215898d 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/host.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/host.lux @@ -70,7 +70,7 @@ (function (_ extension phase archive [fieldS objectS]) (do ////////phase.monad [objectG (phase archive objectS)] - (wrap (_.the fieldS objectG))))])) + (in (_.the fieldS objectG))))])) (def: object::do Handler @@ -80,7 +80,7 @@ (do {! ////////phase.monad} [objectG (phase archive objectS) inputsG (monad.map ! (phase archive) inputsS)] - (wrap (_.do methodS inputsG objectG))))])) + (in (_.do methodS inputsG objectG))))])) (template [<!> <?> <unit>] [(def: <!> (Nullary (Expression Any)) (function.constant <unit>)) @@ -105,7 +105,7 @@ (function (_ extension phase archive name) (do ////////phase.monad [] - (wrap (_.var name))))])) + (in (_.var name))))])) (def: python::import (custom @@ -113,7 +113,7 @@ (function (_ extension phase archive module) (do ////////phase.monad [] - (wrap (_.apply/* (_.var "__import__") (list (_.string module))))))])) + (in (_.apply/* (_.var "__import__") (list (_.string module))))))])) (def: python::apply (custom @@ -122,7 +122,7 @@ (do {! ////////phase.monad} [abstractionG (phase archive abstractionS) inputsG (monad.map ! (phase archive) inputsS)] - (wrap (_.apply/* abstractionG inputsG))))])) + (in (_.apply/* abstractionG inputsG))))])) (def: python::function (custom @@ -135,11 +135,11 @@ (\ ! map _.var)))] g!inputs (monad.map ! (function (_ _) (variable "input")) (list.repeat (.nat arity) []))] - (wrap (_.lambda g!inputs - (case (.nat arity) - 0 (_.apply/1 abstractionG //runtime.unit) - 1 (_.apply/* abstractionG g!inputs) - _ (_.apply/1 abstractionG (_.list g!inputs)))))))])) + (in (_.lambda g!inputs + (case (.nat arity) + 0 (_.apply/1 abstractionG //runtime.unit) + 1 (_.apply/* abstractionG g!inputs) + _ (_.apply/1 abstractionG (_.list g!inputs)))))))])) (def: python::exec (custom @@ -148,7 +148,7 @@ (do {! ////////phase.monad} [codeG (phase archive codeS) globalsG (phase archive globalsS)] - (wrap (//runtime.lux::exec codeG globalsG))))])) + (in (//runtime.lux::exec codeG globalsG))))])) (def: #export bundle Bundle diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/r/common.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/r/common.lux index 36238f9e3..9f43c5f28 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/r/common.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/r/common.lux @@ -49,7 +49,7 @@ (handler extension_name phase archive input') (#try.Failure error) - (/////.throw extension.invalid_syntax [extension_name %synthesis input])))) + (/////.except extension.invalid_syntax [extension_name %synthesis input])))) ## (template: (!unary function) ## (|>> list _.apply/* (|> (_.constant function)))) @@ -71,10 +71,10 @@ ## ## (monad.map ! (function (_ [chars branch]) ## ## (do ! ## ## [branchG (phase archive branch)] -## ## (wrap [(|> chars (list\map (|>> .int _.int (_.=/2 @input))) _.or) +## ## (in [(|> chars (list\map (|>> .int _.int (_.=/2 @input))) _.or) ## ## branchG]))) ## ## conditionals))] -## ## (wrap (_.let (list [@input inputG]) +## ## (in (_.let (list [@input inputG]) ## ## (list (list\fold (function (_ [test then] else) ## ## (_.if test then else)) ## ## elseG diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/ruby/common.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/ruby/common.lux index 4f2cd3291..970566967 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/ruby/common.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/ruby/common.lux @@ -46,7 +46,7 @@ (handler extension_name phase archive input') (#try.Failure error) - (/////.throw extension.invalid_syntax [extension_name %synthesis input])))) + (/////.except extension.invalid_syntax [extension_name %synthesis input])))) ## TODO: Get rid of this ASAP (def: lux::syntax_char_case! @@ -65,21 +65,21 @@ (monad.map ! (function (_ [chars branch]) (do ! [branchG (phase archive branch)] - (wrap [(|> chars - (list\map (|>> .int _.int (_.= @input))) - (list\fold (function (_ clause total) - (if (is? _.nil total) - clause - (_.or clause total))) - _.nil)) - branchG]))) + (in [(|> chars + (list\map (|>> .int _.int (_.= @input))) + (list\fold (function (_ clause total) + (if (is? _.nil total) + clause + (_.or clause total))) + _.nil)) + branchG]))) conditionals)) #let [closure (_.lambda #.None (list @input) (list\fold (function (_ [test then] else) (_.if test (_.return then) else)) (_.return elseG) conditionalsG))]] - (wrap (_.apply_lambda/* (list inputG) closure))))])) + (in (_.apply_lambda/* (list inputG) closure))))])) (def: lux_procs Bundle diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/ruby/host.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/ruby/host.lux index 6f538b8dd..0d0f94f50 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/ruby/host.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/ruby/host.lux @@ -71,7 +71,7 @@ (function (_ extension phase archive [fieldS objectS]) (do ////////phase.monad [objectG (phase archive objectS)] - (wrap (_.the fieldS objectG))))])) + (in (_.the fieldS objectG))))])) (def: object::do Handler @@ -81,7 +81,7 @@ (do {! ////////phase.monad} [objectG (phase archive objectS) inputsG (monad.map ! (phase archive) inputsS)] - (wrap (_.do methodS inputsG objectG))))])) + (in (_.do methodS inputsG objectG))))])) (template [<!> <?> <unit>] [(def: <!> (Nullary Expression) (function.constant <unit>)) @@ -104,7 +104,7 @@ (custom [<s>.text (function (_ extension phase archive name) - (\ ////////phase.monad wrap (_.local name)))])) + (\ ////////phase.monad in (_.local name)))])) (def: ruby::apply (custom @@ -113,13 +113,13 @@ (do {! ////////phase.monad} [abstractionG (phase archive abstractionS) inputsG (monad.map ! (phase archive) inputsS)] - (wrap (_.apply/* inputsG abstractionG))))])) + (in (_.apply/* inputsG abstractionG))))])) (def: ruby::import (custom [<s>.text (function (_ extension phase archive module) - (\ ////////phase.monad wrap + (\ ////////phase.monad in (_.require/1 (_.string module))))])) (def: #export bundle diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/scheme/common.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/scheme/common.lux index 17df72ac2..2025fe4e2 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/scheme/common.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/scheme/common.lux @@ -49,7 +49,7 @@ (handler extension_name phase archive input') (#try.Failure error) - (/////.throw extension.invalid_syntax [extension_name %synthesis input])))) + (/////.except extension.invalid_syntax [extension_name %synthesis input])))) (template: (!unary function) (|>> list _.apply/* (|> (_.constant function)))) @@ -71,14 +71,14 @@ (monad.map ! (function (_ [chars branch]) (do ! [branchG (phase archive branch)] - (wrap [(|> chars (list\map (|>> .int _.int (_.=/2 @input))) _.or) - branchG]))) + (in [(|> chars (list\map (|>> .int _.int (_.=/2 @input))) _.or) + branchG]))) conditionals))] - (wrap (_.let (list [@input inputG]) - (list\fold (function (_ [test then] else) - (_.if test then else)) - elseG - conditionalsG)))))])) + (in (_.let (list [@input inputG]) + (list\fold (function (_ [test then] else) + (_.if test then else)) + elseG + conditionalsG)))))])) (def: lux_procs Bundle diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/scheme/host.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/scheme/host.lux index e67e05db4..33a9624c3 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/scheme/host.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/scheme/host.lux @@ -85,7 +85,7 @@ (function (_ extension phase archive name) (do ////////phase.monad [] - (wrap (_.var name))))])) + (in (_.var name))))])) (def: scheme::apply (custom @@ -94,7 +94,7 @@ (do {! ////////phase.monad} [abstractionG (phase archive abstractionS) inputsG (monad.map ! (phase archive) inputsS)] - (wrap (_.apply/* inputsG abstractionG))))])) + (in (_.apply/* inputsG abstractionG))))])) (def: #export bundle Bundle diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp.lux index 972e318c2..c7ef94ce9 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp.lux @@ -28,7 +28,7 @@ (case synthesis (^template [<tag> <generator>] [(^ (<tag> value)) - (//////phase\wrap (<generator> value))]) + (//////phase\in (<generator> value))]) ([////synthesis.bit /primitive.bit] [////synthesis.i64 /primitive.i64] [////synthesis.f64 /primitive.f64] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/case.lux index 2425e2cb4..45e2a3bba 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/case.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/case.lux @@ -48,8 +48,8 @@ (do ///////phase.monad [valueG (expression archive valueS) bodyG (expression archive bodyS)] - (wrap (_.let (list [(..register register) valueG]) - (list bodyG))))) + (in (_.let (list [(..register register) valueG]) + (list bodyG))))) (def: #export (if expression archive [testS thenS elseS]) (Generator [Synthesis Synthesis Synthesis]) @@ -57,22 +57,22 @@ [testG (expression archive testS) thenG (expression archive thenS) elseG (expression archive elseS)] - (wrap (_.if testG thenG elseG)))) + (in (_.if testG thenG elseG)))) (def: #export (get expression archive [pathP valueS]) (Generator [(List Member) Synthesis]) (do ///////phase.monad [valueG (expression archive valueS)] - (wrap (list\fold (function (_ side source) - (.let [method (.case side - (^template [<side> <accessor>] - [(<side> lefts) - (<accessor> (_.int (.int lefts)))]) - ([#.Left //runtime.tuple//left] - [#.Right //runtime.tuple//right]))] - (method source))) - valueG - pathP)))) + (in (list\fold (function (_ side source) + (.let [method (.case side + (^template [<side> <accessor>] + [(<side> lefts) + (<accessor> (_.int (.int lefts)))]) + ([#.Left //runtime.tuple//left] + [#.Right //runtime.tuple//right]))] + (method source))) + valueG + pathP)))) (def: @savepoint (_.var "lux_pm_savepoint")) (def: @cursor (_.var "lux_pm_cursor")) @@ -148,10 +148,10 @@ (expression archive bodyS)) #/////synthesis.Pop - (///////phase\wrap ..pop!) + (///////phase\in ..pop!) (#/////synthesis.Bind register) - (///////phase\wrap (_.setq (..register register) ..peek)) + (///////phase\in (_.setq (..register register) ..peek)) (#/////synthesis.Bit_Fork when thenP elseP) (do {! ///////phase.monad} @@ -161,14 +161,14 @@ (recur [$output @done @fail elseP]) #.None - (wrap (_.go @fail)))] - (wrap (.if when - (_.if ..peek - then! - else!) - (_.if ..peek - else! - then!)))) + (in (_.go @fail)))] + (in (.if when + (_.if ..peek + then! + else!) + (_.if ..peek + else! + then!)))) (^template [<tag> <format> <=>] [(<tag> cons) @@ -176,21 +176,21 @@ [clauses (monad.map ! (function (_ [match then]) (do ! [then! (recur [$output @done @fail then])] - (wrap [(<=> [(|> match <format>) - ..peek]) - then!]))) + (in [(<=> [(|> match <format>) + ..peek]) + then!]))) (#.Cons cons))] - (wrap (list\fold (function (_ [when then] else) - (_.if when then else)) - (_.go @fail) - clauses)))]) + (in (list\fold (function (_ [when then] else) + (_.if when then else)) + (_.go @fail) + clauses)))]) ([#/////synthesis.I64_Fork //primitive.i64 _.=/2] [#/////synthesis.F64_Fork //primitive.f64 _.=/2] [#/////synthesis.Text_Fork //primitive.text _.string=/2]) (^template [<complex> <simple> <choice>] [(^ (<complex> idx)) - (///////phase\wrap (<choice> @fail false idx #.None)) + (///////phase\in (<choice> @fail false idx #.None)) (^ (<simple> idx nextP)) (|> nextP @@ -200,11 +200,11 @@ [/////synthesis.side/right /////synthesis.simple_right_side ..right_choice]) (^ (/////synthesis.member/left 0)) - (///////phase\wrap (..push! (_.elt/2 [..peek (_.int +0)]))) + (///////phase\in (..push! (_.elt/2 [..peek (_.int +0)]))) (^template [<pm> <getter>] [(^ (<pm> lefts)) - (///////phase\wrap (|> ..peek (<getter> (_.int (.int lefts))) ..push!))]) + (///////phase\in (|> ..peek (<getter> (_.int (.int lefts))) ..push!))]) ([/////synthesis.member/left //runtime.tuple//left] [/////synthesis.member/right //runtime.tuple//right]) @@ -212,21 +212,21 @@ (.let [[extra_pops nextP'] (////synthesis/case.count_pops nextP)] (do ///////phase.monad [next! (recur [$output @done @fail nextP'])] - (///////phase\wrap (_.progn (list (..multi_pop! (n.+ 2 extra_pops)) - next!))))) + (///////phase\in (_.progn (list (..multi_pop! (n.+ 2 extra_pops)) + next!))))) (^ (/////synthesis.path/alt preP postP)) (do {! ///////phase.monad} [@otherwise (\ ! map (|>> %.nat (format "lux_case_otherwise") _.tag) /////generation.next) pre! (recur [$output @done @otherwise preP]) post! (recur [$output @done @fail postP])] - (wrap (..alternation @otherwise pre! post!))) + (in (..alternation @otherwise pre! post!))) (^ (/////synthesis.path/seq preP postP)) (do ///////phase.monad [pre! (recur [$output @done @fail preP]) post! (recur [$output @done @fail postP])] - (wrap (_.progn (list pre! post!))))))) + (in (_.progn (list pre! post!))))))) (def: (pattern_matching $output expression archive pathP) (-> Var/1 (Generator Path)) @@ -234,11 +234,11 @@ [@done (\ ! map (|>> %.nat (format "lux_case_done") _.tag) /////generation.next) @fail (\ ! map (|>> %.nat (format "lux_case_fail") _.tag) /////generation.next) pattern_matching! (pattern_matching' expression archive [$output @done @fail pathP])] - (wrap (_.tagbody - (list pattern_matching! - @fail - (_.error/1 (_.string ////synthesis/case.pattern_matching_error)) - @done))))) + (in (_.tagbody + (list pattern_matching! + @fail + (_.error/1 (_.string ////synthesis/case.pattern_matching_error)) + @done))))) (def: #export (case expression archive [valueS pathP]) (Generator [Synthesis Path]) @@ -253,10 +253,10 @@ (list\map (function (_ register) [(..register register) _.nil])))]] - (wrap (_.let (list& [@cursor (_.list/* (list initG))] - [@savepoint (_.list/* (list))] - [@temp _.nil] - [$output _.nil] - storage) - (list pattern_matching! - $output))))) + (in (_.let (list& [@cursor (_.list/* (list initG))] + [@savepoint (_.list/* (list))] + [@temp _.nil] + [$output _.nil] + storage) + (list pattern_matching! + $output))))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/function.lux index 6adc2d747..a43c24bc8 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/function.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/function.lux @@ -34,7 +34,7 @@ (do {! ///////phase.monad} [functionG (expression archive functionS) argsG+ (monad.map ! (expression archive) argsS+)] - (wrap (_.funcall/+ [functionG argsG+])))) + (in (_.funcall/+ [functionG argsG+])))) (def: capture (-> Register Var/1) @@ -44,16 +44,16 @@ (-> (List (Expression Any)) (Expression Any) (Operation (Expression Any))) (case inits #.Nil - (\ ///////phase.monad wrap function_definition) + (\ ///////phase.monad in function_definition) _ (do {! ///////phase.monad} [@closure (\ ! map _.var (/////generation.gensym "closure"))] - (wrap (_.labels (list [@closure [(|> (list.enumeration inits) - (list\map (|>> product.left ..capture)) - _.args) - function_definition]]) - (_.funcall/+ [(_.function/1 @closure) inits])))))) + (in (_.labels (list [@closure [(|> (list.enumeration inits) + (list\map (|>> product.left ..capture)) + _.args) + function_definition]]) + (_.funcall/+ [(_.function/1 @closure) inits])))))) (def: input (|>> inc //case.register)) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/loop.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/loop.lux index bfe5e2787..5d7faa8f8 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/loop.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/loop.lux @@ -47,15 +47,15 @@ initsG+ (monad.map ! (expression archive) initsS+) bodyG (/////generation.with_anchor [@scope start] (expression archive bodyS))] - (wrap (_.let (|> initsG+ - list.enumeration - (list\map (function (_ [idx init]) - [(|> idx (n.+ start) //case.register) - init])) - (list& [@output _.nil])) - (list (_.tagbody (list @scope - (_.setq @output bodyG))) - @output)))))) + (in (_.let (|> initsG+ + list.enumeration + (list\map (function (_ [idx init]) + [(|> idx (n.+ start) //case.register) + init])) + (list& [@output _.nil])) + (list (_.tagbody (list @scope + (_.setq @output bodyG))) + @output)))))) (def: #export (recur expression archive argsS+) (Generator (List Synthesis)) @@ -66,5 +66,5 @@ list.enumeration (list\map (|>> product.left (n.+ offset) //case.register)) _.args)]] - (wrap (_.progn (list (_.multiple-value-setq bindings (_.values/* argsO+)) - (_.go tag)))))) + (in (_.progn (list (_.multiple-value-setq bindings (_.values/* argsO+)) + (_.go tag)))))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/runtime.lux index 4febcca3c..b9b97fdbe 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/runtime.lux @@ -91,13 +91,13 @@ body) (do {! meta.monad} [ids (monad.seq ! (list.repeat (list.size vars) meta.count))] - (wrap (list (` (let [(~+ (|> vars - (list.zipped/2 ids) - (list\map (function (_ [id var]) - (list (code.local_identifier var) - (` (_.var (~ (code.text (format "v" (%.nat id))))))))) - list.concat))] - (~ body))))))) + (in (list (` (let [(~+ (|> vars + (list.zipped/2 ids) + (list\map (function (_ [id var]) + (list (code.local_identifier var) + (` (_.var (~ (code.text (format "v" (%.nat id))))))))) + list.concat))] + (~ body))))))) (syntax: (runtime: {declaration (<>.or <code>.local_identifier (<code>.form (<>.and <code>.local_identifier @@ -112,13 +112,13 @@ (#.Left name) (let [g!name (code.local_identifier name) code_nameC (code.local_identifier (format "@" name))] - (wrap (list (` (def: #export (~ g!name) - _.Var/1 - (~ runtime_name))) - - (` (def: (~ code_nameC) - (_.Expression Any) - (_.defparameter (~ runtime_name) (~ code))))))) + (in (list (` (def: #export (~ g!name) + _.Var/1 + (~ runtime_name))) + + (` (def: (~ code_nameC) + (_.Expression Any) + (_.defparameter (~ runtime_name) (~ code))))))) (#.Right [name inputs]) (let [g!name (code.local_identifier name) @@ -127,15 +127,15 @@ inputsC (list\map code.local_identifier inputs) inputs_typesC (list\map (function.constant (` (_.Expression Any))) inputs)] - (wrap (list (` (def: #export ((~ g!name) (~+ inputsC)) - (-> (~+ inputs_typesC) (_.Computation Any)) - (_.call/* (~ runtime_name) (list (~+ inputsC))))) - - (` (def: (~ code_nameC) - (_.Expression Any) - (..with_vars [(~+ inputsC)] - (_.defun (~ runtime_name) (_.args (list (~+ inputsC))) - (~ code))))))))))))) + (in (list (` (def: #export ((~ g!name) (~+ inputsC)) + (-> (~+ inputs_typesC) (_.Computation Any)) + (_.call/* (~ runtime_name) (list (~+ inputsC))))) + + (` (def: (~ code_nameC) + (_.Expression Any) + (..with_vars [(~+ inputsC)] + (_.defun (~ runtime_name) (_.args (list (~+ inputsC))) + (~ code))))))))))))) (runtime: (lux//try op) (with_vars [error] @@ -284,10 +284,10 @@ (do ///////phase.monad [_ (/////generation.execute! ..runtime) _ (/////generation.save! (%.nat ..module_id) ..runtime)] - (wrap [(|> artifact.empty - artifact.resource - product.right) - (row.row [(%.nat ..module_id) - (|> ..runtime - _.code - (\ encoding.utf8 encode))])]))) + (in [(|> artifact.empty + artifact.resource + product.right) + (row.row [(%.nat ..module_id) + (|> ..runtime + _.code + (\ encoding.utf8 encode))])]))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/structure.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/structure.lux index 44bd542f6..6cfd16cc4 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/structure.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/structure.lux @@ -18,7 +18,7 @@ (Generator (Tuple Synthesis)) (case elemsS+ #.Nil - (///////phase\wrap (//primitive.text /////synthesis.unit)) + (///////phase\in (//primitive.text /////synthesis.unit)) (#.Cons singletonS #.Nil) (expression archive singletonS) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/extension.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/extension.lux index 5196c6e33..7c50630d7 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/extension.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/extension.lux @@ -22,7 +22,7 @@ ["#" phase]]]]) (syntax: (Vector {size s.nat} elemT) - (wrap (list (` [(~+ (list.repeat size elemT))])))) + (in (list (` [(~+ (list.repeat size elemT))])))) (type: #export (Nullary of) (-> (Vector 0 of) of)) (type: #export (Unary of) (-> (Vector 1 of) of)) @@ -34,22 +34,22 @@ (with_gensyms [g!_ g!extension g!name g!phase g!archive g!inputs g!of g!anchor g!expression g!directive] (do {! meta.monad} [g!input+ (monad.seq ! (list.repeat arity (macro.gensym "input")))] - (wrap (list (` (def: #export ((~ (code.local_identifier name)) (~ g!extension)) - (All [(~ g!anchor) (~ g!expression) (~ g!directive)] - (-> ((~ type) (~ g!expression)) - (generation.Handler (~ g!anchor) (~ g!expression) (~ g!directive)))) - (function ((~ g!_) (~ g!name) (~ g!phase) (~ g!archive) (~ g!inputs)) - (case (~ g!inputs) - (^ (list (~+ g!input+))) - (do ///.monad - [(~+ (|> g!input+ - (list\map (function (_ g!input) - (list g!input (` ((~ g!phase) (~ g!archive) (~ g!input)))))) - list.concat))] - ((~' wrap) ((~ g!extension) [(~+ g!input+)]))) + (in (list (` (def: #export ((~ (code.local_identifier name)) (~ g!extension)) + (All [(~ g!anchor) (~ g!expression) (~ g!directive)] + (-> ((~ type) (~ g!expression)) + (generation.Handler (~ g!anchor) (~ g!expression) (~ g!directive)))) + (function ((~ g!_) (~ g!name) (~ g!phase) (~ g!archive) (~ g!inputs)) + (case (~ g!inputs) + (^ (list (~+ g!input+))) + (do ///.monad + [(~+ (|> g!input+ + (list\map (function (_ g!input) + (list g!input (` ((~ g!phase) (~ g!archive) (~ g!input)))))) + list.concat))] + ((~' in) ((~ g!extension) [(~+ g!input+)]))) - (~' _) - (///.throw ///extension.incorrect_arity [(~ g!name) 1 (list.size (~ g!inputs))])))))))))) + (~' _) + (///.except ///extension.incorrect_arity [(~ g!name) 1 (list.size (~ g!inputs))])))))))))) (arity: 0 nullary ..Nullary) (arity: 1 unary ..Unary) @@ -63,4 +63,4 @@ (function (_ phase archive inputsS) (do {! ///.monad} [inputsI (monad.map ! (phase archive) inputsS)] - (wrap (extension inputsI)))))) + (in (extension inputsI)))))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js.lux index 18319d0a2..20a26e9cb 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js.lux @@ -70,7 +70,7 @@ (case synthesis (^template [<tag> <generator>] [(^ (<tag> value)) - (//////phase\wrap (<generator> value))]) + (//////phase\in (<generator> value))]) ([synthesis.bit /primitive.bit] [synthesis.i64 /primitive.i64] [synthesis.f64 /primitive.f64] @@ -101,7 +101,7 @@ (/loop.scope ..statement expression archive scope) (^ (synthesis.loop/recur updates)) - (//////phase.throw ..cannot-recur-as-an-expression []) + (//////phase.except ..cannot-recur-as-an-expression []) (^ (synthesis.function/abstraction abstraction)) (/function.function ..statement expression archive abstraction) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/case.lux index 76da7c8f1..8c0ef681a 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/case.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/case.lux @@ -41,18 +41,18 @@ [valueO (expression archive valueS) bodyO (expression archive bodyS)] ## TODO: Find some way to do 'let' without paying the price of the closure. - (wrap (_.apply/* (_.closure (list (..register register)) - (_.return bodyO)) - (list valueO))))) + (in (_.apply/* (_.closure (list (..register register)) + (_.return bodyO)) + (list valueO))))) (def: #export (let! statement expression archive [valueS register bodyS]) (Generator! [Synthesis Register Synthesis]) (do ///////phase.monad [valueO (expression archive valueS) bodyO (statement expression archive bodyS)] - (wrap ($_ _.then - (_.define (..register register) valueO) - bodyO)))) + (in ($_ _.then + (_.define (..register register) valueO) + bodyO)))) (def: #export (if expression archive [testS thenS elseS]) (Generator [Synthesis Synthesis Synthesis]) @@ -60,7 +60,7 @@ [testO (expression archive testS) thenO (expression archive thenS) elseO (expression archive elseS)] - (wrap (_.? testO thenO elseO)))) + (in (_.? testO thenO elseO)))) (def: #export (if! statement expression archive [testS thenS elseS]) (Generator! [Synthesis Synthesis Synthesis]) @@ -68,24 +68,24 @@ [testO (expression archive testS) thenO (statement expression archive thenS) elseO (statement expression archive elseS)] - (wrap (_.if testO - thenO - elseO)))) + (in (_.if testO + thenO + elseO)))) (def: #export (get expression archive [pathP valueS]) (Generator [(List Member) Synthesis]) (do ///////phase.monad [valueO (expression archive valueS)] - (wrap (list\fold (function (_ side source) - (.let [method (.case side - (^template [<side> <accessor>] - [(<side> lefts) - (<accessor> (_.i32 (.int lefts)))]) - ([#.Left //runtime.tuple//left] - [#.Right //runtime.tuple//right]))] - (method source))) - valueO - (list.reverse pathP))))) + (in (list\fold (function (_ side source) + (.let [method (.case side + (^template [<side> <accessor>] + [(<side> lefts) + (<accessor> (_.i32 (.int lefts)))]) + ([#.Left //runtime.tuple//left] + [#.Right //runtime.tuple//right]))] + (method source))) + valueO + (list.reverse pathP))))) (def: @savepoint (_.var "lux_pm_cursor_savepoint")) (def: @cursor (_.var "lux_pm_cursor")) @@ -170,7 +170,7 @@ [/////synthesis.simple_right_side ..right_choice]) (^ (/////synthesis.member/left 0)) - (///////phase\wrap (#.Some (push_cursor! (_.at (_.i32 +0) ..peek_cursor)))) + (///////phase\in (#.Some (push_cursor! (_.at (_.i32 +0) ..peek_cursor)))) ## Extra optimization (^ (/////synthesis.path/seq @@ -178,9 +178,9 @@ (/////synthesis.!bind_top register thenP))) (do ///////phase.monad [then! (recur thenP)] - (wrap (#.Some ($_ _.then - (_.define (..register register) (_.at (_.i32 +0) ..peek_cursor)) - then!)))) + (in (#.Some ($_ _.then + (_.define (..register register) (_.at (_.i32 +0) ..peek_cursor)) + then!)))) ## Extra optimization (^template [<pm> <getter>] @@ -189,29 +189,29 @@ (/////synthesis.!bind_top register thenP))) (do ///////phase.monad [then! (recur thenP)] - (wrap (#.Some ($_ _.then - (_.define (..register register) (<getter> (_.i32 (.int lefts)) ..peek_cursor)) - then!))))]) + (in (#.Some ($_ _.then + (_.define (..register register) (<getter> (_.i32 (.int lefts)) ..peek_cursor)) + then!))))]) ([/////synthesis.member/left //runtime.tuple//left] [/////synthesis.member/right //runtime.tuple//right]) (^ (/////synthesis.!bind_top register thenP)) (do ///////phase.monad [then! (recur thenP)] - (wrap (#.Some ($_ _.then - (_.define (..register register) ..peek_and_pop_cursor) - then!)))) + (in (#.Some ($_ _.then + (_.define (..register register) ..peek_and_pop_cursor) + then!)))) (^ (/////synthesis.!multi_pop nextP)) (.let [[extra_pops nextP'] (////synthesis/case.count_pops nextP)] (do ///////phase.monad [next! (recur nextP')] - (wrap (#.Some ($_ _.then - (multi_pop_cursor! (n.+ 2 extra_pops)) - next!))))) + (in (#.Some ($_ _.then + (multi_pop_cursor! (n.+ 2 extra_pops)) + next!))))) _ - (///////phase\wrap #.None))) + (///////phase\in #.None))) (def: (pattern_matching' statement expression archive) (-> Phase! Phase Archive @@ -221,7 +221,7 @@ [outcome (optimized_pattern_matching recur pathP)] (.case outcome (#.Some outcome) - (wrap outcome) + (in outcome) #.None (.case pathP @@ -229,10 +229,10 @@ (statement expression archive bodyS) #/////synthesis.Pop - (///////phase\wrap pop_cursor!) + (///////phase\in pop_cursor!) (#/////synthesis.Bind register) - (///////phase\wrap (_.define (..register register) ..peek_cursor)) + (///////phase\in (_.define (..register register) ..peek_cursor)) (#/////synthesis.Bit_Fork when thenP elseP) (do {! ///////phase.monad} @@ -242,25 +242,25 @@ (recur elseP) #.None - (wrap ..fail_pm!))] - (wrap (.if when - (_.if ..peek_cursor - then! - else!) - (_.if ..peek_cursor - else! - then!)))) + (in ..fail_pm!))] + (in (.if when + (_.if ..peek_cursor + then! + else!) + (_.if ..peek_cursor + else! + then!)))) (#/////synthesis.I64_Fork cons) (do {! ///////phase.monad} [clauses (monad.map ! (function (_ [match then]) (do ! [then! (recur then)] - (wrap [(//runtime.i64//= (//primitive.i64 (.int match)) - ..peek_cursor) - then!]))) + (in [(//runtime.i64//= (//primitive.i64 (.int match)) + ..peek_cursor) + then!]))) (#.Cons cons))] - (wrap (_.cond clauses ..fail_pm!))) + (in (_.cond clauses ..fail_pm!))) (^template [<tag> <format>] [(<tag> cons) @@ -268,21 +268,21 @@ [cases (monad.map ! (function (_ [match then]) (\ ! map (|>> [(list (<format> match))]) (recur then))) (#.Cons cons))] - (wrap (_.switch ..peek_cursor - cases - (#.Some ..fail_pm!))))]) + (in (_.switch ..peek_cursor + cases + (#.Some ..fail_pm!))))]) ([#/////synthesis.F64_Fork //primitive.f64] [#/////synthesis.Text_Fork //primitive.text]) (^template [<complex> <choice>] [(^ (<complex> idx)) - (///////phase\wrap (<choice> false idx))]) + (///////phase\in (<choice> false idx))]) ([/////synthesis.side/left ..left_choice] [/////synthesis.side/right ..right_choice]) (^template [<pm> <getter>] [(^ (<pm> lefts)) - (///////phase\wrap (push_cursor! (<getter> (_.i32 (.int lefts)) ..peek_cursor)))]) + (///////phase\in (push_cursor! (<getter> (_.i32 (.int lefts)) ..peek_cursor)))]) ([/////synthesis.member/left //runtime.tuple//left] [/////synthesis.member/right //runtime.tuple//right]) @@ -291,7 +291,7 @@ (do ///////phase.monad [left! (recur leftP) right! (recur rightP)] - (wrap (<combinator> left! right!)))]) + (in (<combinator> left! right!)))]) ([/////synthesis.path/seq _.then] [/////synthesis.path/alt ..alternation])))))) @@ -299,24 +299,24 @@ (-> Phase! Phase Archive Path (Operation Statement)) (do ///////phase.monad [pattern_matching! (pattern_matching' statement expression archive pathP)] - (wrap ($_ _.then - (_.do_while (_.boolean false) - pattern_matching!) - (_.throw (_.string ////synthesis/case.pattern_matching_error)))))) + (in ($_ _.then + (_.do_while (_.boolean false) + pattern_matching!) + (_.throw (_.string ////synthesis/case.pattern_matching_error)))))) (def: #export (case! statement expression archive [valueS pathP]) (Generator! [Synthesis Path]) (do ///////phase.monad [stack_init (expression archive valueS) pattern_matching! (pattern_matching statement expression archive pathP)] - (wrap ($_ _.then - (_.declare @temp) - (_.define @cursor (_.array (list stack_init))) - (_.define @savepoint (_.array (list))) - pattern_matching!)))) + (in ($_ _.then + (_.declare @temp) + (_.define @cursor (_.array (list stack_init))) + (_.define @savepoint (_.array (list))) + pattern_matching!)))) (def: #export (case statement expression archive [valueS pathP]) (-> Phase! (Generator [Synthesis Path])) (do ///////phase.monad [pattern_matching! (..case! statement expression archive [valueS pathP])] - (wrap (_.apply/* (_.closure (list) pattern_matching!) (list))))) + (in (_.apply/* (_.closure (list) pattern_matching!) (list))))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/function.lux index 0f2d9adf6..b06f9e347 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/function.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/function.lux @@ -32,7 +32,7 @@ (do {! ///////phase.monad} [functionO (expression archive functionS) argsO+ (monad.map ! (expression archive) argsS+)] - (wrap (_.apply/* functionO argsO+)))) + (in (_.apply/* functionO argsO+)))) (def: capture (-> Register Var) @@ -120,4 +120,4 @@ ))] _ (/////generation.execute! definition) _ (/////generation.save! (product.right function_name) #.None definition)] - (wrap instantiation))) + (in instantiation))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/loop.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/loop.lux index 720257105..8e9f4265c 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/loop.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/loop.lux @@ -55,10 +55,10 @@ initsO+ (monad.map ! (expression archive) initsS+) body! (/////generation.with_anchor [start @scope] (statement expression archive bodyS))] - (wrap (..setup true start initsO+ - (_.with_label (_.label @scope) - (_.do_while (_.boolean true) - body!))))))) + (in (..setup true start initsO+ + (_.with_label (_.label @scope) + (_.do_while (_.boolean true) + body!))))))) (def: #export (scope statement expression archive [start initsS+ bodyS]) (-> Phase! (Generator (Scope Synthesis))) @@ -71,7 +71,7 @@ _ (do {! ///////phase.monad} [loop! (scope! statement expression archive [start initsS+ bodyS])] - (wrap (_.apply/* (_.closure (list) loop!) (list)))))) + (in (_.apply/* (_.closure (list) loop!) (list)))))) (def: @temp (_.var "lux_recur_values")) @@ -81,11 +81,11 @@ (do {! ///////phase.monad} [[offset @scope] /////generation.anchor argsO+ (monad.map ! (expression archive) argsS+)] - (wrap ($_ _.then - (_.define @temp (_.array argsO+)) - (..setup false offset - (|> argsO+ - list.enumeration - (list\map (function (_ [idx _]) - (_.at (_.i32 (.int idx)) @temp)))) - (_.continue_at (_.label @scope))))))) + (in ($_ _.then + (_.define @temp (_.array argsO+)) + (..setup false offset + (|> argsO+ + list.enumeration + (list\map (function (_ [idx _]) + (_.at (_.i32 (.int idx)) @temp)))) + (_.continue_at (_.label @scope))))))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux index a4c5ebd10..506a957c7 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux @@ -89,13 +89,13 @@ body) (do {! meta.monad} [ids (monad.seq ! (list.repeat (list.size vars) meta.count))] - (wrap (list (` (let [(~+ (|> vars - (list.zipped/2 ids) - (list\map (function (_ [id var]) - (list (code.local_identifier var) - (` (_.var (~ (code.text (format "v" (%.nat id))))))))) - list.concat))] - (~ body))))))) + (in (list (` (let [(~+ (|> vars + (list.zipped/2 ids) + (list\map (function (_ [id var]) + (list (code.local_identifier var) + (` (_.var (~ (code.text (format "v" (%.nat id))))))))) + list.concat))] + (~ body))))))) (syntax: (runtime: {declaration (<>.or <code>.local_identifier (<code>.form (<>.and <code>.local_identifier @@ -106,31 +106,31 @@ (case declaration (#.Left name) (let [g!name (code.local_identifier name)] - (wrap (list (` (def: #export (~ g!name) - Var - (~ runtime_name))) - - (` (def: (~ (code.local_identifier (format "@" name))) - Statement - (..feature (~ runtime_name) - (function ((~ g!_) (~ g!name)) - (~ code)))))))) + (in (list (` (def: #export (~ g!name) + Var + (~ runtime_name))) + + (` (def: (~ (code.local_identifier (format "@" name))) + Statement + (..feature (~ runtime_name) + (function ((~ g!_) (~ g!name)) + (~ code)))))))) (#.Right [name inputs]) (let [g!name (code.local_identifier name) inputsC (list\map code.local_identifier inputs) inputs_typesC (list\map (function.constant (` _.Expression)) inputs)] - (wrap (list (` (def: #export ((~ g!name) (~+ inputsC)) - (-> (~+ inputs_typesC) Computation) - (_.apply/* (~ runtime_name) (list (~+ inputsC))))) - - (` (def: (~ (code.local_identifier (format "@" name))) - Statement - (..feature (~ runtime_name) - (function ((~ g!_) (~ g!_)) - (..with_vars [(~+ inputsC)] - (_.function (~ g!_) (list (~+ inputsC)) - (~ code)))))))))))))) + (in (list (` (def: #export ((~ g!name) (~+ inputsC)) + (-> (~+ inputs_typesC) Computation) + (_.apply/* (~ runtime_name) (list (~+ inputsC))))) + + (` (def: (~ (code.local_identifier (format "@" name))) + Statement + (..feature (~ runtime_name) + (function ((~ g!_) (~ g!_)) + (..with_vars [(~+ inputsC)] + (_.function (~ g!_) (list (~+ inputsC)) + (~ code)))))))))))))) (def: length (-> Expression Computation) @@ -776,11 +776,11 @@ (do ///////phase.monad [_ (/////generation.execute! ..runtime) _ (/////generation.save! ..module_id #.None ..runtime)] - (wrap [(|> artifact.empty - artifact.resource - product.right) - (row.row [..module_id - #.None - (|> ..runtime - _.code - (\ utf8.codec encode))])]))) + (in [(|> artifact.empty + artifact.resource + product.right) + (row.row [..module_id + #.None + (|> ..runtime + _.code + (\ utf8.codec encode))])]))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/structure.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/structure.lux index 8c68d5b23..1b3f8e526 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/structure.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/structure.lux @@ -18,7 +18,7 @@ (Generator (Tuple Synthesis)) (case elemsS+ #.Nil - (///////phase\wrap //runtime.unit) + (///////phase\in //runtime.unit) (#.Cons singletonS #.Nil) (generate archive singletonS) @@ -26,7 +26,7 @@ _ (do {! ///////phase.monad} [elemsT+ (monad.map ! (generate archive) elemsS+)] - (wrap (_.array elemsT+))))) + (in (_.array elemsT+))))) (def: #export (variant generate archive [lefts right? valueS]) (Generator (Variant Synthesis)) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm.lux index e8357027d..629f7704e 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm.lux @@ -24,7 +24,7 @@ (case synthesis (^template [<tag> <generator>] [(^ (<tag> value)) - (///\wrap (<generator> value))]) + (///\in (<generator> value))]) ([synthesis.bit /primitive.bit] [synthesis.i64 /primitive.i64] [synthesis.f64 /primitive.f64] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/case.lux index 74cbae5c8..04d5926a7 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/case.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/case.lux @@ -38,7 +38,7 @@ (def: (pop_alt stack_depth) (-> Nat (Bytecode Any)) (.case stack_depth - 0 (_\wrap []) + 0 (_\in []) 1 _.pop 2 _.pop2 _ ## (n.> 2) @@ -93,24 +93,24 @@ (-> Nat Label Label (Generator Path)) (.case path #synthesis.Pop - (operation\wrap ..pop) + (operation\in ..pop) (#synthesis.Bind register) - (operation\wrap ($_ _.compose - ..peek - (_.astore register))) + (operation\in ($_ _.compose + ..peek + (_.astore register))) (#synthesis.Then bodyS) (do phase.monad [bodyG (phase archive bodyS)] - (wrap ($_ _.compose - (..pop_alt stack_depth) - bodyG - (_.goto @end)))) + (in ($_ _.compose + (..pop_alt stack_depth) + bodyG + (_.goto @end)))) (^template [<pattern> <right?>] [(^ (<pattern> lefts)) - (operation\wrap + (operation\in (do _.monad [@success _.new_label @fail _.new_label] @@ -133,10 +133,10 @@ (^template [<pattern> <projection>] [(^ (<pattern> lefts)) - (operation\wrap ($_ _.compose - ..peek - (<projection> lefts) - //runtime.push))]) + (operation\in ($_ _.compose + ..peek + (<projection> lefts) + //runtime.push))]) ([synthesis.member/left ..left_projection] [synthesis.member/right ..right_projection]) @@ -146,13 +146,13 @@ (synthesis.!bind_top register thenP))) (do phase.monad [thenG (path' stack_depth @else @end phase archive thenP)] - (wrap ($_ _.compose - ..peek - (_.checkcast //type.tuple) - _.iconst_0 - _.aaload - (_.astore register) - thenG))) + (in ($_ _.compose + ..peek + (_.checkcast //type.tuple) + _.iconst_0 + _.aaload + (_.astore register) + thenG))) ## Extra optimization (^template [<pm> <projection>] @@ -161,13 +161,13 @@ (synthesis.!bind_top register thenP))) (do phase.monad [then! (path' stack_depth @else @end phase archive thenP)] - (wrap ($_ _.compose - ..peek - (_.checkcast //type.tuple) - (..int lefts) - <projection> - (_.astore register) - then!)))]) + (in ($_ _.compose + ..peek + (_.checkcast //type.tuple) + (..int lefts) + <projection> + (_.astore register) + then!)))]) ([synthesis.member/left //runtime.left_projection] [synthesis.member/right //runtime.right_projection]) @@ -176,20 +176,20 @@ [@alt_else //runtime.forge_label left! (path' (inc stack_depth) @alt_else @end phase archive leftP) right! (path' stack_depth @else @end phase archive rightP)] - (wrap ($_ _.compose - _.dup - left! - (_.set_label @alt_else) - _.pop - right!))) + (in ($_ _.compose + _.dup + left! + (_.set_label @alt_else) + _.pop + right!))) (#synthesis.Seq leftP rightP) (do phase.monad [left! (path' stack_depth @else @end phase archive leftP) right! (path' stack_depth @else @end phase archive rightP)] - (wrap ($_ _.compose - left! - right!))) + (in ($_ _.compose + left! + right!))) _ (undefined) @@ -200,13 +200,13 @@ (do phase.monad [@else //runtime.forge_label pathG (..path' 1 @else @end phase archive path)] - (wrap ($_ _.compose - pathG - (_.set_label @else) - _.pop - //runtime.pm_failure - _.aconst_null - (_.goto @end))))) + (in ($_ _.compose + pathG + (_.set_label @else) + _.pop + //runtime.pm_failure + _.aconst_null + (_.goto @end))))) (def: #export (if phase archive [conditionS thenS elseS]) (Generator [Synthesis Synthesis Synthesis]) @@ -214,43 +214,43 @@ [conditionG (phase archive conditionS) thenG (phase archive thenS) elseG (phase archive elseS)] - (wrap (do _.monad - [@else _.new_label - @end _.new_label] - ($_ _.compose - conditionG - (//value.unwrap type.boolean) - (_.ifeq @else) - thenG - (_.goto @end) - (_.set_label @else) - elseG - (_.set_label @end)))))) + (in (do _.monad + [@else _.new_label + @end _.new_label] + ($_ _.compose + conditionG + (//value.unwrap type.boolean) + (_.ifeq @else) + thenG + (_.goto @end) + (_.set_label @else) + elseG + (_.set_label @end)))))) (def: #export (let phase archive [inputS register bodyS]) (Generator [Synthesis Register Synthesis]) (do phase.monad [inputG (phase archive inputS) bodyG (phase archive bodyS)] - (wrap ($_ _.compose - inputG - (_.astore register) - bodyG)))) + (in ($_ _.compose + inputG + (_.astore register) + bodyG)))) (def: #export (get phase archive [path recordS]) (Generator [(List synthesis.Member) Synthesis]) (do phase.monad [recordG (phase archive recordS)] - (wrap (list\fold (function (_ step so_far) - (.let [next (.case step - (#.Left lefts) - (..left_projection lefts) - - (#.Right lefts) - (..right_projection lefts))] - (_.compose so_far next))) - recordG - (list.reverse path))))) + (in (list\fold (function (_ step so_far) + (.let [next (.case step + (#.Left lefts) + (..left_projection lefts) + + (#.Right lefts) + (..right_projection lefts))] + (_.compose so_far next))) + recordG + (list.reverse path))))) (def: #export (case phase archive [valueS path]) (Generator [Synthesis Path]) @@ -258,9 +258,9 @@ [@end //runtime.forge_label valueG (phase archive valueS) pathG (..path @end phase archive path)] - (wrap ($_ _.compose - _.aconst_null - valueG - //runtime.push - pathG - (_.set_label @end))))) + (in ($_ _.compose + _.aconst_null + valueG + //runtime.push + pathG + (_.set_label @end))))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/debug.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/debug.lux index 65c141283..82f5b442b 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/debug.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/debug.lux @@ -15,17 +15,17 @@ (def: extension ".class") -(def: #export (write-class! name bytecode) +(def: #export (write_class! name bytecode) (-> Text Binary (IO Text)) - (let [file-path (format name ..extension)] + (let [file_path (format name ..extension)] (do io.monad [outcome (do (try.with @) [file (: (IO (Try (File IO))) - (file.get-file io.monad file.default file-path))] - (\ file over-write bytecode))] - (wrap (case outcome - (#try.Success definition) - file-path + (file.get_file io.monad file.default file_path))] + (\ file over_write bytecode))] + (in (case outcome + (#try.Success definition) + file_path - (#try.Failure error) - error))))) + (#try.Failure error) + error))))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux index 42d9cf2a4..640543f45 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux @@ -79,7 +79,7 @@ (list (/implementation.method' //runtime.apply::name arity @begin body)))))] (do phase.monad [instance (/new.instance generate archive classT environment arity)] - (wrap [fields methods instance])))) + (in [fields methods instance])))) (def: modifier (Modifier Class) @@ -114,22 +114,22 @@ #let [bytecode (format.run class.writer class)] _ (generation.execute! [function_class bytecode]) _ (generation.save! function_class #.None [function_class bytecode])] - (wrap instance))) + (in instance))) (def: #export (apply generate archive [abstractionS inputsS]) (Generator Apply) (do {! phase.monad} [abstractionG (generate archive abstractionS) inputsG (monad.map ! (generate archive) inputsS)] - (wrap ($_ _.compose - abstractionG - (|> inputsG - (list.chunk /arity.maximum) - (monad.map _.monad - (function (_ batchG) - ($_ _.compose - (_.checkcast /abstract.class) - (monad.seq _.monad batchG) - (_.invokevirtual /abstract.class //runtime.apply::name (//runtime.apply::type (list.size batchG))) - )))) - )))) + (in ($_ _.compose + abstractionG + (|> inputsG + (list.chunk /arity.maximum) + (monad.map _.monad + (function (_ batchG) + ($_ _.compose + (_.checkcast /abstract.class) + (monad.seq _.monad batchG) + (_.invokevirtual /abstract.class //runtime.apply::name (//runtime.apply::type (list.size batchG))) + )))) + )))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable/foreign.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable/foreign.lux index 4506bb2f8..ccfd84401 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable/foreign.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable/foreign.lux @@ -29,12 +29,12 @@ (def: #export (get class register) (-> (Type Class) Register (Bytecode Any)) - (//.get class (/////reference.foreign-name register))) + (//.get class (/////reference.foreign_name register))) (def: #export (put class register value) (-> (Type Class) Register (Bytecode Any) (Bytecode Any)) - (//.put /////reference.foreign-name class register value)) + (//.put /////reference.foreign_name class register value)) (def: #export variables (-> (Environment Synthesis) (List (Resource Field))) - (|>> list.size (//.variables /////reference.foreign-name))) + (|>> list.size (//.variables /////reference.foreign_name))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable/partial.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable/partial.lux index 0a2e25b3d..7e5e8a6ca 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable/partial.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable/partial.lux @@ -33,22 +33,22 @@ (def: #export (initial amount) (-> Nat (Bytecode Any)) ($_ _.compose - (|> _.aconst-null + (|> _.aconst_null (list.repeat amount) (monad.seq _.monad)) - (_\wrap []))) + (_\in []))) (def: #export (get class register) (-> (Type Class) Register (Bytecode Any)) - (//.get class (/////reference.partial-name register))) + (//.get class (/////reference.partial_name register))) (def: #export (put class register value) (-> (Type Class) Register (Bytecode Any) (Bytecode Any)) - (//.put /////reference.partial-name class register value)) + (//.put /////reference.partial_name class register value)) (def: #export variables (-> Arity (List (Resource Field))) - (|>> (n.- ///arity.minimum) (//.variables /////reference.partial-name))) + (|>> (n.- ///arity.minimum) (//.variables /////reference.partial_name))) (def: #export (new arity) (-> Arity (Bytecode Any)) @@ -56,4 +56,4 @@ ($_ _.compose /count.initial (initial (n.- ///arity.minimum arity))) - (_\wrap []))) + (_\in []))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/apply.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/apply.lux index 943604bbc..cfe49a36b 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/apply.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/apply.lux @@ -59,7 +59,7 @@ (|> amount list.indices (monad.map _.monad (|>> (n.+ offset) _.aload))) - (_\wrap []) + (_\in []) )) (def: (apply offset amount) @@ -72,7 +72,7 @@ (if (n.> ///arity.maximum amount) (apply (n.+ ///arity.maximum offset) (n.- ///arity.maximum amount)) - (_\wrap [])) + (_\in [])) ))) (def: this_offset 1) @@ -114,7 +114,7 @@ ////reference.this (if already_partial? (_.invokevirtual class //reset.name (//reset.type class)) - (_\wrap [])) + (_\in [])) current_partials (..inputs ..this_offset apply_arity) (_.invokevirtual class //implementation.name (//implementation.type function_arity)) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/implementation.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/implementation.lux index 14cde40a2..347ab1a8a 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/implementation.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/implementation.lux @@ -32,7 +32,7 @@ (..type arity) (list) (#.Some ($_ _.compose - (_.set-label @begin) + (_.set_label @begin) body _.areturn )))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/new.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/new.lux index 19c84c828..1707b1413 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/new.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/new.lux @@ -55,7 +55,7 @@ (-> Phase Archive (Type Class) (Environment Synthesis) Arity (Operation (Bytecode Any))) (do {! phase.monad} [foreign* (monad.map ! (generate archive) environment)] - (wrap (instance' foreign* class environment arity)))) + (in (instance' foreign* class environment arity)))) (def: #export (method class environment arity) (-> (Type Class) (Environment Synthesis) Arity (Resource Method)) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/reset.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/reset.lux index 229538870..8ad6fd92e 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/reset.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/reset.lux @@ -32,7 +32,7 @@ (-> (Type Class) (Type category.Method)) (type.method [(list) class (list)])) -(def: (current-environment class) +(def: (current_environment class) (-> (Type Class) (Environment Synthesis) (List (Bytecode Any))) (|>> list.size list.indices @@ -45,6 +45,6 @@ (list) (#.Some ($_ _.compose (if (arity.multiary? arity) - (//new.instance' (..current-environment class environment) class environment arity) + (//new.instance' (..current_environment class environment) class environment arity) ////reference.this) _.areturn)))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/host.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/host.lux index c0fb1765f..fc9f4d3ca 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/host.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/host.lux @@ -1,7 +1,7 @@ (.module: [library [lux (#- Definition) - ["." ffi (#+ import: do-to object)] + ["." ffi (#+ import: do_to object)] [abstract [monad (#+ do)]] [control @@ -60,22 +60,22 @@ (def: init::type (type.method [(list) type.void (list)])) (def: init::modifier ($_ modifier\compose method.public method.static method.strict)) -(exception: #export (cannot-load {class Text} {error Text}) +(exception: #export (cannot_load {class Text} {error Text}) (exception.report ["Class" class] ["Error" error])) -(exception: #export (invalid-field {class Text} {field Text} {error Text}) +(exception: #export (invalid_field {class Text} {field Text} {error Text}) (exception.report ["Class" class] ["Field" field] ["Error" error])) -(exception: #export (invalid-value {class Text}) +(exception: #export (invalid_value {class Text}) (exception.report ["Class" class])) -(def: (class-value class-name class) +(def: (class_value class_name class) (-> Text (java/lang/Class java/lang/Object) (Try Any)) (case (java/lang/Class::getField ..value::field class) (#try.Success field) @@ -86,22 +86,23 @@ (#try.Success value) #.None - (exception.throw ..invalid-value [class-name])) + (exception.except ..invalid_value [class_name])) (#try.Failure error) - (exception.throw ..cannot-load [class-name error])) + (exception.except ..cannot_load [class_name error])) (#try.Failure error) - (exception.throw ..invalid-field [class-name ..value::field error]))) + (exception.except ..invalid_field [class_name ..value::field error]))) -(def: class-path-separator ".") +(def: class_path_separator + ".") -(def: (evaluate! library loader eval-class valueG) +(def: (evaluate! library loader eval_class valueG) (-> Library java/lang/ClassLoader Text (Bytecode Any) (Try [Any Definition])) - (let [bytecode-name (text.replace-all class-path-separator .module-separator eval-class) + (let [bytecode_name (text.replace_all class_path_separator .module_separator eval_class) bytecode (class.class version.v6_0 class.public - (encoding/name.internal bytecode-name) + (encoding/name.internal bytecode_name) (encoding/name.internal "java.lang.Object") (list) (list (field.field ..value::modifier ..value::field ..value::type (row.row))) (list (method.method ..init::modifier "<clinit>" ..init::type @@ -109,50 +110,50 @@ (#.Some ($_ _.compose valueG - (_.putstatic (type.class bytecode-name (list)) ..value::field ..value::type) + (_.putstatic (type.class bytecode_name (list)) ..value::field ..value::type) _.return)))) (row.row))] (io.run (do {! (try.with io.monad)} [bytecode (\ ! map (format.run class.writer) (io.io bytecode)) - _ (loader.store eval-class bytecode library) - class (loader.load eval-class loader) - value (\ io.monad wrap (class-value eval-class class))] - (wrap [value - [eval-class bytecode]]))))) + _ (loader.store eval_class bytecode library) + class (loader.load eval_class loader) + value (\ io.monad in (class_value eval_class class))] + (in [value + [eval_class bytecode]]))))) -(def: (execute! library loader temp-label [class-name class-bytecode]) +(def: (execute! library loader temp_label [class_name class_bytecode]) (-> Library java/lang/ClassLoader Text Definition (Try Any)) (io.run (do (try.with io.monad) - [existing-class? (|> (atom.read library) + [existing_class? (|> (atom.read library) (\ io.monad map (function (_ library) - (dictionary.key? library class-name))) + (dictionary.key? library class_name))) (try.lift io.monad) (: (IO (Try Bit)))) - _ (if existing-class? - (wrap []) - (loader.store class-name class-bytecode library))] - (loader.load class-name loader)))) + _ (if existing_class? + (in []) + (loader.store class_name class_bytecode library))] + (loader.load class_name loader)))) (def: (define! library loader [module name] valueG) (-> Library java/lang/ClassLoader Name (Bytecode Any) (Try [Text Any Definition])) - (let [class-name (format (text.replace-all .module-separator class-path-separator module) - class-path-separator (name.normal name) + (let [class_name (format (text.replace_all .module_separator class_path_separator module) + class_path_separator (name.normal name) "___" (%.nat (text\hash name)))] (do try.monad - [[value definition] (evaluate! library loader class-name valueG)] - (wrap [class-name value definition])))) + [[value definition] (evaluate! library loader class_name valueG)] + (in [class_name value definition])))) (def: #export host (IO //runtime.Host) - (io (let [library (loader.new-library []) + (io (let [library (loader.new_library []) loader (loader.memory library)] (: //runtime.Host (implementation - (def: (evaluate! temp-label valueG) - (let [eval-class (|> temp-label name.normal (text.replace-all " " "$"))] + (def: (evaluate! temp_label valueG) + (let [eval_class (|> temp_label name.normal (text.replace_all " " "$"))] (\ try.monad map product.left - (..evaluate! library loader eval-class valueG)))) + (..evaluate! library loader eval_class valueG)))) (def: execute! (..execute! library loader)) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/loop.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/loop.lux index 465e8d1af..ba6cb27ef 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/loop.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/loop.lux @@ -34,8 +34,8 @@ _ false)) -(def: no-op - (_\wrap [])) +(def: no_op + (_\in [])) (def: #export (recur translate archive updatesS) (Generator (List Synthesis)) @@ -47,36 +47,36 @@ [(n.+ offset index) updateS])) (monad.map ! (function (_ [register updateS]) (if (invariant? register updateS) - (wrap [..no-op - ..no-op]) + (in [..no_op + ..no_op]) (do ! [fetchG (translate archive updateS) #let [storeG (_.astore register)]] - (wrap [fetchG storeG]))))))] - (wrap ($_ _.compose - ## It may look weird that first I fetch all the values separately, - ## and then I store them all. - ## It must be done that way in order to avoid a potential bug. - ## Let's say that you'll recur with 2 expressions: X and Y. - ## If Y depends on the value of X, and you don't perform fetches - ## and stores separately, then by the time Y is evaluated, it - ## will refer to the new value of X, instead of the old value, as - ## should be the case. - (|> updatesG - (list\map product.left) - (monad.seq _.monad)) - (|> updatesG - list.reverse - (list\map product.right) - (monad.seq _.monad)) - (_.goto @begin))))) + (in [fetchG storeG]))))))] + (in ($_ _.compose + ## It may look weird that first I fetch all the values separately, + ## and then I store them all. + ## It must be done that way in order to avoid a potential bug. + ## Let's say that you'll recur with 2 expressions: X and Y. + ## If Y depends on the value of X, and you don't perform fetches + ## and stores separately, then by the time Y is evaluated, it + ## will refer to the new value of X, instead of the old value, as + ## should be the case. + (|> updatesG + (list\map product.left) + (monad.seq _.monad)) + (|> updatesG + list.reverse + (list\map product.right) + (monad.seq _.monad)) + (_.goto @begin))))) (def: #export (scope translate archive [offset initsS+ iterationS]) (Generator [Nat (List Synthesis) Synthesis]) (do {! phase.monad} - [@begin //runtime.forge-label + [@begin //runtime.forge_label initsI+ (monad.map ! (translate archive) initsS+) - iterationG (generation.with-anchor [@begin offset] + iterationG (generation.with_anchor [@begin offset] (translate archive iterationS)) #let [initializationG (|> (list.enumeration initsI+) (list\map (function (_ [index initG]) @@ -84,7 +84,7 @@ initG (_.astore (n.+ offset index))))) (monad.seq _.monad))]] - (wrap ($_ _.compose - initializationG - (_.set-label @begin) - iterationG)))) + (in ($_ _.compose + initializationG + (_.set_label @begin) + iterationG)))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/primitive.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/primitive.lux index 6b24fb2f5..42f9a24fa 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/primitive.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/primitive.lux @@ -21,7 +21,7 @@ (-> Bit (Bytecode Any)) (_.getstatic $Boolean (if value "TRUE" "FALSE") $Boolean)) -(def: wrap-i64 +(def: wrap_i64 (_.invokestatic $Long "valueOf" (type.method [(list type.long) $Long (list)]))) (def: #export (i64 value) @@ -31,23 +31,23 @@ [<int> (do _.monad [_ <instruction>] - ..wrap-i64)]) - ([+0 _.lconst-0] - [+1 _.lconst-1]) + ..wrap_i64)]) + ([+0 _.lconst_0] + [+1 _.lconst_1]) (^template [<int> <instruction>] [<int> (do _.monad [_ <instruction> _ _.i2l] - ..wrap-i64)]) - ([-1 _.iconst-m1] - ## [+0 _.iconst-0] - ## [+1 _.iconst-1] - [+2 _.iconst-2] - [+3 _.iconst-3] - [+4 _.iconst-4] - [+5 _.iconst-5]) + ..wrap_i64)]) + ([-1 _.iconst_m1] + ## [+0 _.iconst_0] + ## [+1 _.iconst_1] + [+2 _.iconst_2] + [+3 _.iconst_3] + [+4 _.iconst_4] + [+5 _.iconst_5]) value (case (signed.s1 value) @@ -55,7 +55,7 @@ (do _.monad [_ (_.bipush value) _ _.i2l] - ..wrap-i64) + ..wrap_i64) (#try.Failure _) (case (signed.s2 value) @@ -63,14 +63,14 @@ (do _.monad [_ (_.sipush value) _ _.i2l] - ..wrap-i64) + ..wrap_i64) (#try.Failure _) (do _.monad [_ (_.long value)] - ..wrap-i64))))) + ..wrap_i64))))) -(def: wrap-f64 +(def: wrap_f64 (_.invokestatic $Double "valueOf" (type.method [(list type.double) $Double (list)]))) (import: java/lang/Double @@ -83,39 +83,39 @@ [<int> (do _.monad [_ <instruction>] - ..wrap-f64)]) - ([+1.0 _.dconst-1]) + ..wrap_f64)]) + ([+1.0 _.dconst_1]) (^template [<int> <instruction>] [<int> (do _.monad [_ <instruction> _ _.f2d] - ..wrap-f64)]) - ([+2.0 _.fconst-2]) + ..wrap_f64)]) + ([+2.0 _.fconst_2]) (^template [<int> <instruction>] [<int> (do _.monad [_ <instruction> _ _.i2d] - ..wrap-f64)]) - ([-1.0 _.iconst-m1] - ## [+0.0 _.iconst-0] - ## [+1.0 _.iconst-1] - [+2.0 _.iconst-2] - [+3.0 _.iconst-3] - [+4.0 _.iconst-4] - [+5.0 _.iconst-5]) + ..wrap_f64)]) + ([-1.0 _.iconst_m1] + ## [+0.0 _.iconst_0] + ## [+1.0 _.iconst_1] + [+2.0 _.iconst_2] + [+3.0 _.iconst_3] + [+4.0 _.iconst_4] + [+5.0 _.iconst_5]) _ - (let [constantI (if (i.= ..d0-bits + (let [constantI (if (i.= ..d0_bits (java/lang/Double::doubleToRawLongBits (:as java/lang/Double value))) - _.dconst-0 + _.dconst_0 (_.double value))] (do _.monad [_ constantI] - ..wrap-f64)))) + ..wrap_f64)))) (def: #export text _.string) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/reference.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/reference.lux index 441cf5c63..2e3fe8618 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/reference.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/reference.lux @@ -44,17 +44,17 @@ (do {! ////.monad} [bytecode_name (\ ! map //runtime.class_name (generation.context archive))] - (wrap ($_ _.compose - ..this - (_.getfield (type.class bytecode_name (list)) - (..foreign_name variable) - //type.value))))) + (in ($_ _.compose + ..this + (_.getfield (type.class bytecode_name (list)) + (..foreign_name variable) + //type.value))))) (def: #export (variable archive variable) (-> Archive Variable (Operation (Bytecode Any))) (case variable (#variable.Local variable) - (operation\wrap (_.aload variable)) + (operation\in (_.aload variable)) (#variable.Foreign variable) (..foreign archive variable))) @@ -64,4 +64,4 @@ (do {! ////.monad} [bytecode_name (\ ! map //runtime.class_name (generation.remember archive name))] - (wrap (_.getstatic (type.class bytecode_name (list)) //value.field //type.value)))) + (in (_.getstatic (type.class bytecode_name (list)) //value.field //type.value)))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/structure.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/structure.lux index 6bc0ffe91..b997af01d 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/structure.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/structure.lux @@ -30,7 +30,7 @@ (Generator (Tuple Synthesis)) (case membersS #.Nil - (\ phase.monad wrap //runtime.unit) + (\ phase.monad in //runtime.unit) (#.Cons singletonS #.Nil) (generate archive singletonS) @@ -42,15 +42,15 @@ (monad.map ! (function (_ [idx member]) (do ! [memberI (generate archive member)] - (wrap (do _.monad - [_ _.dup - _ (_.int (.i64 idx)) - _ memberI] - _.aastore))))))] - (wrap (do {! _.monad} - [_ (_.int (.i64 (list.size membersS))) - _ (_.anewarray $Object)] - (monad.seq ! membersI)))))) + (in (do _.monad + [_ _.dup + _ (_.int (.i64 idx)) + _ memberI] + _.aastore))))))] + (in (do {! _.monad} + [_ (_.int (.i64 (list.size membersS))) + _ (_.anewarray $Object)] + (monad.seq ! membersI)))))) (def: #export (tag lefts right?) (-> Nat Bit (Bytecode Any)) @@ -85,11 +85,11 @@ (Generator (Variant Synthesis)) (do phase.monad [valueI (generate archive valueS)] - (wrap (do _.monad - [_ (..tag lefts right?) - _ (..flag right?) - _ valueI] - (_.invokestatic //runtime.class "variant" - (type.method [(list type.int $Object $Object) - (type.array $Object) - (list)])))))) + (in (do _.monad + [_ (..tag lefts right?) + _ (..flag right?) + _ valueI] + (_.invokestatic //runtime.class "variant" + (type.method [(list type.int $Object $Object) + (type.array $Object) + (list)])))))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua.lux index 529dd28a0..3c9054abf 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua.lux @@ -56,7 +56,7 @@ (^ (synthesis.loop/scope scope)) (do //////phase.monad [[inits scope!] (/loop.scope! statement expression archive false scope)] - (wrap scope!)) + (in scope!)) (^ (synthesis.loop/recur updates)) (/loop.recur! statement expression archive updates) @@ -72,7 +72,7 @@ (case synthesis (^template [<tag> <generator>] [(^ (<tag> value)) - (//////phase\wrap (<generator> value))]) + (//////phase\in (<generator> value))]) ([synthesis.bit /primitive.bit] [synthesis.i64 /primitive.i64] [synthesis.f64 /primitive.f64] @@ -103,7 +103,7 @@ (/loop.scope ..statement expression archive scope) (^ (synthesis.loop/recur updates)) - (//////phase.throw ..cannot-recur-as-an-expression []) + (//////phase.except ..cannot-recur-as-an-expression []) (^ (synthesis.function/abstraction abstraction)) (/function.function ..statement expression archive abstraction) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/case.lux index 0be2698f8..94b086149 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/case.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/case.lux @@ -44,34 +44,34 @@ [valueO (expression archive valueS) bodyO (expression archive bodyS)] ## TODO: Find some way to do 'let' without paying the price of the closure. - (wrap (|> bodyO - _.return - (_.closure (list (..register register))) - (_.apply/* (list valueO)))))) + (in (|> bodyO + _.return + (_.closure (list (..register register))) + (_.apply/* (list valueO)))))) (def: #export (let! statement expression archive [valueS register bodyS]) (Generator! [Synthesis Register Synthesis]) (do ///////phase.monad [valueO (expression archive valueS) bodyO (statement expression archive bodyS)] - (wrap ($_ _.then - (_.local/1 (..register register) valueO) - bodyO)))) + (in ($_ _.then + (_.local/1 (..register register) valueO) + bodyO)))) (def: #export (get expression archive [pathP valueS]) (Generator [(List Member) Synthesis]) (do ///////phase.monad [valueO (expression archive valueS)] - (wrap (list\fold (function (_ side source) - (.let [method (.case side - (^template [<side> <accessor>] - [(<side> lefts) - (<accessor> (_.int (.int lefts)))]) - ([#.Left //runtime.tuple//left] - [#.Right //runtime.tuple//right]))] - (method source))) - valueO - (list.reverse pathP))))) + (in (list\fold (function (_ side source) + (.let [method (.case side + (^template [<side> <accessor>] + [(<side> lefts) + (<accessor> (_.int (.int lefts)))]) + ([#.Left //runtime.tuple//left] + [#.Right //runtime.tuple//right]))] + (method source))) + valueO + (list.reverse pathP))))) (def: #export (if expression archive [testS thenS elseS]) (Generator [Synthesis Synthesis Synthesis]) @@ -79,11 +79,11 @@ [testO (expression archive testS) thenO (expression archive thenS) elseO (expression archive elseS)] - (wrap (|> (_.if testO - (_.return thenO) - (_.return elseO)) - (_.closure (list)) - (_.apply/* (list)))))) + (in (|> (_.if testO + (_.return thenO) + (_.return elseO)) + (_.closure (list)) + (_.apply/* (list)))))) (def: #export (if! statement expression archive [testS thenS elseS]) (Generator! [Synthesis Synthesis Synthesis]) @@ -91,9 +91,9 @@ [testO (expression archive testS) thenO (statement expression archive thenS) elseO (statement expression archive elseS)] - (wrap (_.if testO - thenO - elseO)))) + (in (_.if testO + thenO + elseO)))) (def: @savepoint (_.var "lux_pm_savepoint")) (def: @cursor (_.var "lux_pm_cursor")) @@ -167,10 +167,10 @@ (statement expression archive bodyS) #/////synthesis.Pop - (///////phase\wrap ..pop!) + (///////phase\in ..pop!) (#/////synthesis.Bind register) - (///////phase\wrap (_.local/1 (..register register) ..peek)) + (///////phase\in (_.local/1 (..register register) ..peek)) (#/////synthesis.Bit_Fork when thenP elseP) (do {! ///////phase.monad} @@ -180,14 +180,14 @@ (recur elseP) #.None - (wrap ..fail!))] - (wrap (.if when - (_.if ..peek - then! - else!) - (_.if ..peek - else! - then!)))) + (in ..fail!))] + (in (.if when + (_.if ..peek + then! + else!) + (_.if ..peek + else! + then!)))) (^template [<tag> <format>] [(<tag> cons) @@ -195,18 +195,18 @@ [clauses (monad.map ! (function (_ [match then]) (do ! [then! (recur then)] - (wrap [(_.= (|> match <format>) - ..peek) - then!]))) + (in [(_.= (|> match <format>) + ..peek) + then!]))) (#.Cons cons))] - (wrap (_.cond clauses ..fail!)))]) + (in (_.cond clauses ..fail!)))]) ([#/////synthesis.I64_Fork (<| _.int .int)] [#/////synthesis.F64_Fork _.float] [#/////synthesis.Text_Fork _.string]) (^template [<complex> <simple> <choice>] [(^ (<complex> idx)) - (///////phase\wrap (<choice> false idx)) + (///////phase\in (<choice> false idx)) (^ (<simple> idx nextP)) (///////phase\map (_.then (<choice> true idx)) (recur nextP))]) @@ -214,27 +214,27 @@ [/////synthesis.side/right /////synthesis.simple_right_side ..right_choice]) (^ (/////synthesis.member/left 0)) - (///////phase\wrap (|> ..peek (_.nth (_.int +1)) ..push!)) + (///////phase\in (|> ..peek (_.nth (_.int +1)) ..push!)) (^template [<pm> <getter>] [(^ (<pm> lefts)) - (///////phase\wrap (|> ..peek (<getter> (_.int (.int lefts))) ..push!))]) + (///////phase\in (|> ..peek (<getter> (_.int (.int lefts))) ..push!))]) ([/////synthesis.member/left //runtime.tuple//left] [/////synthesis.member/right //runtime.tuple//right]) (^ (/////synthesis.!bind_top register thenP)) (do ///////phase.monad [then! (recur thenP)] - (///////phase\wrap ($_ _.then - (_.local/1 (..register register) ..peek_and_pop) - then!))) + (///////phase\in ($_ _.then + (_.local/1 (..register register) ..peek_and_pop) + then!))) (^template [<tag> <combinator>] [(^ (<tag> preP postP)) (do ///////phase.monad [pre! (recur preP) post! (recur postP)] - (wrap (<combinator> pre! post!)))]) + (in (<combinator> pre! post!)))]) ([/////synthesis.path/seq _.then] [/////synthesis.path/alt ..alternation])))) @@ -242,10 +242,10 @@ (-> Phase! Phase Archive Path (Operation Statement)) (do ///////phase.monad [pattern_matching! (pattern_matching' statement expression archive pathP)] - (wrap ($_ _.then - (_.while (_.bool true) - pattern_matching!) - (_.statement (|> (_.var "error") (_.apply/* (list (_.string ////synthesis/case.pattern_matching_error))))))))) + (in ($_ _.then + (_.while (_.bool true) + pattern_matching!) + (_.statement (|> (_.var "error") (_.apply/* (list (_.string ////synthesis/case.pattern_matching_error))))))))) (def: #export dependencies (-> Path (List Var)) @@ -265,11 +265,11 @@ (do ///////phase.monad [stack_init (expression archive valueS) pattern_matching! (pattern_matching statement expression archive pathP)] - (wrap ($_ _.then - (_.local (list @temp)) - (_.local/1 @cursor (_.array (list stack_init))) - (_.local/1 @savepoint (_.array (list))) - pattern_matching!)))) + (in ($_ _.then + (_.local (list @temp)) + (_.local/1 @cursor (_.array (list stack_init))) + (_.local/1 @savepoint (_.array (list))) + pattern_matching!)))) (def: #export (case statement expression archive [valueS pathP]) (-> Phase! (Generator [Synthesis Path])) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/function.lux index 789d30fcc..66f2aa0c4 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/function.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/function.lux @@ -34,7 +34,7 @@ (do {! ///////phase.monad} [functionO (expression archive functionS) argsO+ (monad.map ! (expression archive) argsS+)] - (wrap (_.apply/* argsO+ functionO)))) + (in (_.apply/* argsO+ functionO)))) (def: capture (-> Register Var) @@ -134,4 +134,4 @@ ))] _ (/////generation.execute! definition) _ (/////generation.save! (product.right function_name) #.None definition)] - (wrap instantiation))) + (in instantiation))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux index 6004e31a8..7d063fa09 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux @@ -65,11 +65,11 @@ initsO+ (monad.map ! (expression archive) initsS+) body! (/////generation.with_anchor [start @scope] (statement expression archive bodyS))] - (wrap [initsO+ - (..setup true start initsO+ as_expression? - ($_ _.then - (_.set_label @scope) - body!))])))) + (in [initsO+ + (..setup true start initsO+ as_expression? + ($_ _.then + (_.set_label @scope) + body!))])))) (def: #export (scope statement expression archive [start initsS+ bodyS]) (-> Phase! (Generator (Scope Synthesis))) @@ -109,11 +109,11 @@ (|> @context (_.apply/* foreigns))])))] _ (/////generation.execute! directive) _ (/////generation.save! artifact_id #.None directive)] - (wrap (|> instantiation (_.apply/* initsO+)))))) + (in (|> instantiation (_.apply/* initsO+)))))) (def: #export (recur! statement expression archive argsS+) (Generator! (List Synthesis)) (do {! ///////phase.monad} [[offset @scope] /////generation.anchor argsO+ (monad.map ! (expression archive) argsS+)] - (wrap (..setup false offset argsO+ false (_.go_to @scope))))) + (in (..setup false offset argsO+ false (_.go_to @scope))))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux index f01c90d7a..1565f7c0e 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux @@ -106,13 +106,13 @@ body) (do {! meta.monad} [ids (monad.seq ! (list.repeat (list.size vars) meta.count))] - (wrap (list (` (let [(~+ (|> vars - (list.zipped/2 ids) - (list\map (function (_ [id var]) - (list (code.local_identifier var) - (` (_.var (~ (code.text (format "v" (%.nat id))))))))) - list.concat))] - (~ body))))))) + (in (list (` (let [(~+ (|> vars + (list.zipped/2 ids) + (list\map (function (_ [id var]) + (list (code.local_identifier var) + (` (_.var (~ (code.text (format "v" (%.nat id))))))))) + list.concat))] + (~ body))))))) (def: module_id 0) @@ -130,15 +130,15 @@ (#.Left name) (macro.with_gensyms [g!_] (let [g!name (code.local_identifier name)] - (wrap (list (` (def: #export (~ g!name) - Var - (~ runtime_name))) - - (` (def: (~ (code.local_identifier (format "@" name))) - Statement - (..feature (~ runtime_name) - (function ((~ g!_) (~ g!name)) - (_.set (~ g!name) (~ code)))))))))) + (in (list (` (def: #export (~ g!name) + Var + (~ runtime_name))) + + (` (def: (~ (code.local_identifier (format "@" name))) + Statement + (..feature (~ runtime_name) + (function ((~ g!_) (~ g!name)) + (_.set (~ g!name) (~ code)))))))))) (#.Right [name inputs]) (macro.with_gensyms [g!_] @@ -146,17 +146,17 @@ inputsC (list\map code.local_identifier inputs) inputs_typesC (list\map (function.constant (` _.Expression)) inputs)] - (wrap (list (` (def: #export ((~ g!name) (~+ inputsC)) - (-> (~+ inputs_typesC) Computation) - (_.apply/* (list (~+ inputsC)) (~ runtime_name)))) - - (` (def: (~ (code.local_identifier (format "@" name))) - Statement - (..feature (~ runtime_name) - (function ((~ g!_) (~ g!_)) - (..with_vars [(~+ inputsC)] - (_.function (~ g!_) (list (~+ inputsC)) - (~ code)))))))))))))))) + (in (list (` (def: #export ((~ g!name) (~+ inputsC)) + (-> (~+ inputs_typesC) Computation) + (_.apply/* (list (~+ inputsC)) (~ runtime_name)))) + + (` (def: (~ (code.local_identifier (format "@" name))) + Statement + (..feature (~ runtime_name) + (function ((~ g!_) (~ g!_)) + (..with_vars [(~+ inputsC)] + (_.function (~ g!_) (list (~+ inputsC)) + (~ code)))))))))))))))) (def: (nth index table) (-> Expression Expression Location) @@ -423,11 +423,11 @@ (do ///////phase.monad [_ (/////generation.execute! ..runtime) _ (/////generation.save! ..module_id #.None ..runtime)] - (wrap [(|> artifact.empty - artifact.resource - product.right) - (row.row [..module_id - #.None - (|> ..runtime - _.code - (\ utf8.codec encode))])]))) + (in [(|> artifact.empty + artifact.resource + product.right) + (row.row [..module_id + #.None + (|> ..runtime + _.code + (\ utf8.codec encode))])]))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/structure.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/structure.lux index ff9bae4be..56954873e 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/structure.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/structure.lux @@ -18,7 +18,7 @@ (Generator (Tuple Synthesis)) (case elemsS+ #.Nil - (///////phase\wrap (//primitive.text /////synthesis.unit)) + (///////phase\in (//primitive.text /////synthesis.unit)) (#.Cons singletonS #.Nil) (generate archive singletonS) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php.lux index 5bcb2770d..12714b2cd 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php.lux @@ -66,7 +66,7 @@ (case synthesis (^template [<tag> <generator>] [(^ (<tag> value)) - (//////phase\wrap (<generator> value))]) + (//////phase\in (<generator> value))]) ([////synthesis.bit /primitive.bit] [////synthesis.i64 /primitive.i64] [////synthesis.f64 /primitive.f64] @@ -93,7 +93,7 @@ [////synthesis.function/abstraction /function.function]) (^ (////synthesis.loop/recur _)) - (//////phase.throw ..cannot-recur-as-an-expression []) + (//////phase.except ..cannot-recur-as-an-expression []) (#////synthesis.Extension extension) (///extension.apply archive expression extension))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/case.lux index d6a4c67b0..48a05b104 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/case.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/case.lux @@ -47,19 +47,19 @@ (do ///////phase.monad [valueG (expression archive valueS) bodyG (expression archive bodyS)] - (wrap (|> bodyG - (list (_.set (..register register) valueG)) - _.array/* - (_.nth (_.int +1)))))) + (in (|> bodyG + (list (_.set (..register register) valueG)) + _.array/* + (_.nth (_.int +1)))))) (def: #export (let! statement expression archive [valueS register bodyS]) (Generator! [Synthesis Register Synthesis]) (do ///////phase.monad [valueO (expression archive valueS) body! (statement expression archive bodyS)] - (wrap ($_ _.then - (_.set! (..register register) valueO) - body!)))) + (in ($_ _.then + (_.set! (..register register) valueO) + body!)))) (def: #export (if expression archive [testS thenS elseS]) (Generator [Synthesis Synthesis Synthesis]) @@ -67,7 +67,7 @@ [testG (expression archive testS) thenG (expression archive thenS) elseG (expression archive elseS)] - (wrap (_.? testG thenG elseG)))) + (in (_.? testG thenG elseG)))) (def: #export (if! statement expression archive [testS thenS elseS]) (Generator! [Synthesis Synthesis Synthesis]) @@ -75,24 +75,24 @@ [test! (expression archive testS) then! (statement expression archive thenS) else! (statement expression archive elseS)] - (wrap (_.if test! - then! - else!)))) + (in (_.if test! + then! + else!)))) (def: #export (get expression archive [pathP valueS]) (Generator [(List Member) Synthesis]) (do ///////phase.monad [valueG (expression archive valueS)] - (wrap (list\fold (function (_ side source) - (.let [method (.case side - (^template [<side> <accessor>] - [(<side> lefts) - (<accessor> (_.int (.int lefts)))]) - ([#.Left //runtime.tuple//left] - [#.Right //runtime.tuple//right]))] - (method source))) - valueG - (list.reverse pathP))))) + (in (list\fold (function (_ side source) + (.let [method (.case side + (^template [<side> <accessor>] + [(<side> lefts) + (<accessor> (_.int (.int lefts)))]) + ([#.Left //runtime.tuple//left] + [#.Right //runtime.tuple//right]))] + (method source))) + valueG + (list.reverse pathP))))) (def: @savepoint (_.var "lux_pm_savepoint")) (def: @cursor (_.var "lux_pm_cursor")) @@ -167,10 +167,10 @@ (statement expression archive bodyS) #/////synthesis.Pop - (///////phase\wrap ..pop!) + (///////phase\in ..pop!) (#/////synthesis.Bind register) - (///////phase\wrap (_.set! (..register register) ..peek)) + (///////phase\in (_.set! (..register register) ..peek)) (#/////synthesis.Bit_Fork when thenP elseP) (do {! ///////phase.monad} @@ -180,14 +180,14 @@ (recur elseP) #.None - (wrap ..fail!))] - (wrap (.if when - (_.if ..peek - then! - else!) - (_.if ..peek - else! - then!)))) + (in ..fail!))] + (in (.if when + (_.if ..peek + then! + else!) + (_.if ..peek + else! + then!)))) (^template [<tag> <format>] [(<tag> cons) @@ -195,18 +195,18 @@ [clauses (monad.map ! (function (_ [match then]) (do ! [then! (recur then)] - (wrap [(_.=== (|> match <format>) - ..peek) - then!]))) + (in [(_.=== (|> match <format>) + ..peek) + then!]))) (#.Cons cons))] - (wrap (_.cond clauses ..fail!)))]) + (in (_.cond clauses ..fail!)))]) ([#/////synthesis.I64_Fork //primitive.i64] [#/////synthesis.F64_Fork //primitive.f64] [#/////synthesis.Text_Fork //primitive.text]) (^template [<complex> <simple> <choice>] [(^ (<complex> idx)) - (///////phase\wrap (<choice> false idx)) + (///////phase\in (<choice> false idx)) (^ (<simple> idx nextP)) (|> nextP @@ -216,26 +216,26 @@ [/////synthesis.side/right /////synthesis.simple_right_side ..right_choice]) (^ (/////synthesis.member/left 0)) - (///////phase\wrap (|> ..peek (_.nth (_.int +0)) ..push!)) + (///////phase\in (|> ..peek (_.nth (_.int +0)) ..push!)) (^template [<pm> <getter>] [(^ (<pm> lefts)) - (///////phase\wrap (|> ..peek (<getter> (_.int (.int lefts))) ..push!))]) + (///////phase\in (|> ..peek (<getter> (_.int (.int lefts))) ..push!))]) ([/////synthesis.member/left //runtime.tuple//left] [/////synthesis.member/right //runtime.tuple//right]) (^ (/////synthesis.!bind_top register thenP)) (do ///////phase.monad [then! (recur thenP)] - (///////phase\wrap ($_ _.then - (_.set! (..register register) ..peek_and_pop) - then!))) + (///////phase\in ($_ _.then + (_.set! (..register register) ..peek_and_pop) + then!))) ## (^ (/////synthesis.!multi_pop nextP)) ## (.let [[extra_pops nextP'] (////synthesis/case.count_pops nextP)] ## (do ///////phase.monad ## [next! (recur nextP')] - ## (///////phase\wrap ($_ _.then + ## (///////phase\in ($_ _.then ## (..multi_pop! (n.+ 2 extra_pops)) ## next!)))) @@ -244,7 +244,7 @@ (do ///////phase.monad [pre! (recur preP) post! (recur postP)] - (wrap (<combinator> pre! post!)))]) + (in (<combinator> pre! post!)))]) ([/////synthesis.path/seq _.then] [/////synthesis.path/alt ..alternation])))) @@ -252,10 +252,10 @@ (Generator! Path) (do ///////phase.monad [iteration! (pattern_matching' statement expression archive pathP)] - (wrap ($_ _.then - (_.do_while (_.bool false) - iteration!) - (_.throw (_.new (_.constant "Exception") (list (_.string ////synthesis/case.pattern_matching_error)))))))) + (in ($_ _.then + (_.do_while (_.bool false) + iteration!) + (_.throw (_.new (_.constant "Exception") (list (_.string ////synthesis/case.pattern_matching_error)))))))) (def: (gensym prefix) (-> Text (Operation Text)) @@ -279,10 +279,10 @@ (do ///////phase.monad [stack_init (expression archive valueS) pattern_matching! (pattern_matching statement expression archive pathP)] - (wrap ($_ _.then - (_.set! @cursor (_.array/* (list stack_init))) - (_.set! @savepoint (_.array/* (list))) - pattern_matching!)))) + (in ($_ _.then + (_.set! @cursor (_.array/* (list stack_init))) + (_.set! @savepoint (_.array/* (list))) + pattern_matching!)))) (def: #export (case statement expression archive [valueS pathP]) (-> Phase! (Generator [Synthesis Path])) @@ -295,4 +295,4 @@ directive (_.define_function @case (list\map _.parameter @dependencies+) case!)] _ (/////generation.execute! directive) _ (/////generation.save! case_artifact directive)] - (wrap (_.apply/* @dependencies+ @case)))) + (in (_.apply/* @dependencies+ @case)))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/function.lux index 819f6b244..d1cfcea2e 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/function.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/function.lux @@ -34,7 +34,7 @@ (do {! ///////phase.monad} [functionG (expression archive functionS) argsG+ (monad.map ! (expression archive) argsS+)] - (wrap (_.apply/*' argsG+ functionG)))) + (in (_.apply/*' argsG+ functionG)))) (def: capture (-> Register Var) @@ -113,4 +113,4 @@ ))] _ (/////generation.execute! definition) _ (/////generation.save! (product.right function_name) definition)] - (wrap instantiation))) + (in instantiation))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/loop.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/loop.lux index 8b99967a2..4952b71ab 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/loop.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/loop.lux @@ -61,10 +61,10 @@ initsO+ (monad.map ! (expression archive) initsS+) body! (/////generation.with_anchor [start @scope] (statement expression archive bodyS))] - (wrap (..setup start initsO+ - ($_ _.then - (_.set_label @scope) - body!)))))) + (in (..setup start initsO+ + ($_ _.then + (_.set_label @scope) + body!)))))) (def: #export (scope statement expression archive [start initsS+ bodyS]) (-> Phase! (Generator (Scope Synthesis))) @@ -102,7 +102,7 @@ (_.apply/* foreigns @loop)]))] _ (/////generation.execute! directive) _ (/////generation.save! loop_artifact directive)] - (wrap (_.apply/* (list) instantiation))))) + (in (_.apply/* (list) instantiation))))) (def: @temp (_.var "lux_recur_values")) @@ -112,11 +112,11 @@ (do {! ///////phase.monad} [[offset @scope] /////generation.anchor argsO+ (monad.map ! (expression archive) argsS+)] - (wrap ($_ _.then - (_.set! @temp (_.array/* argsO+)) - (..setup offset - (|> argsO+ - list.enumeration - (list\map (function (_ [idx _]) - (_.nth (_.int (.int idx)) @temp)))) - (_.go_to @scope)))))) + (in ($_ _.then + (_.set! @temp (_.array/* argsO+)) + (..setup offset + (|> argsO+ + list.enumeration + (list\map (function (_ [idx _]) + (_.nth (_.int (.int idx)) @temp)))) + (_.go_to @scope)))))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/runtime.lux index 07b72e742..9729815b6 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/runtime.lux @@ -74,13 +74,13 @@ body) (do {! meta.monad} [ids (monad.seq ! (list.repeat (list.size vars) meta.count))] - (wrap (list (` (let [(~+ (|> vars - (list.zipped/2 ids) - (list\map (function (_ [id var]) - (list (code.local_identifier var) - (` (_.var (~ (code.text (format "v" (%.nat id))))))))) - list.concat))] - (~ body))))))) + (in (list (` (let [(~+ (|> vars + (list.zipped/2 ids) + (list\map (function (_ [id var]) + (list (code.local_identifier var) + (` (_.var (~ (code.text (format "v" (%.nat id))))))))) + list.concat))] + (~ body))))))) (def: module_id 0) @@ -98,15 +98,15 @@ (#.Left name) (macro.with_gensyms [g!_] (let [g!name (code.local_identifier name)] - (wrap (list (` (def: #export (~ g!name) - Var - (~ runtime_name))) - - (` (def: (~ (code.local_identifier (format "@" name))) - Statement - (..feature (~ runtime_name) - (function ((~ g!_) (~ g!name)) - (_.define (~ g!name) (~ code)))))))))) + (in (list (` (def: #export (~ g!name) + Var + (~ runtime_name))) + + (` (def: (~ (code.local_identifier (format "@" name))) + Statement + (..feature (~ runtime_name) + (function ((~ g!_) (~ g!name)) + (_.define (~ g!name) (~ code)))))))))) (#.Right [name inputs]) (macro.with_gensyms [g!_] @@ -114,18 +114,18 @@ inputsC (list\map code.local_identifier inputs) inputs_typesC (list\map (function.constant (` _.Expression)) inputs)] - (wrap (list (` (def: #export ((~ g!name) (~+ inputsC)) - (-> (~+ inputs_typesC) Computation) - (_.apply/* (list (~+ inputsC)) (~ runtime_name)))) - - (` (def: (~ (code.local_identifier (format "@" name))) - Statement - (..feature (~ runtime_name) - (function ((~ g!_) (~ g!_)) - (..with_vars [(~+ inputsC)] - (_.define_function (~ g!_) - (list (~+ (list\map (|>> (~) [false] (`)) inputsC))) - (~ code)))))))))))))))) + (in (list (` (def: #export ((~ g!name) (~+ inputsC)) + (-> (~+ inputs_typesC) Computation) + (_.apply/* (list (~+ inputsC)) (~ runtime_name)))) + + (` (def: (~ (code.local_identifier (format "@" name))) + Statement + (..feature (~ runtime_name) + (function ((~ g!_) (~ g!_)) + (..with_vars [(~+ inputsC)] + (_.define_function (~ g!_) + (list (~+ (list\map (|>> (~) [false] (`)) inputsC))) + (~ code)))))))))))))))) (runtime: (io//log! message) ($_ _.then @@ -601,10 +601,10 @@ (do ///////phase.monad [_ (/////generation.execute! ..runtime) _ (/////generation.save! ..module_id ..runtime)] - (wrap [(|> artifact.empty - artifact.resource - product.right) - (row.row [..module_id - (|> ..runtime - _.code - (\ utf8.codec encode))])]))) + (in [(|> artifact.empty + artifact.resource + product.right) + (row.row [..module_id + (|> ..runtime + _.code + (\ utf8.codec encode))])]))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/structure.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/structure.lux index 8d9334dca..5d01a16c6 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/structure.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/structure.lux @@ -21,7 +21,7 @@ (Generator (Tuple Synthesis)) (case elemsS+ #.Nil - (///////phase\wrap (//primitive.text /////synthesis.unit)) + (///////phase\in (//primitive.text /////synthesis.unit)) (#.Cons singletonS #.Nil) (expression archive singletonS) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python.lux index 683a64ffe..d88f2eb0c 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python.lux @@ -66,7 +66,7 @@ (case synthesis (^template [<tag> <generator>] [(^ (<tag> value)) - (//////phase\wrap (<generator> value))]) + (//////phase\in (<generator> value))]) ([////synthesis.bit /primitive.bit] [////synthesis.i64 /primitive.i64] [////synthesis.f64 /primitive.f64] @@ -97,7 +97,7 @@ (/loop.scope ..statement expression archive scope) (^ (////synthesis.loop/recur updates)) - (//////phase.throw ..cannot-recur-as-an-expression []) + (//////phase.except ..cannot-recur-as-an-expression []) (^ (////synthesis.function/abstraction abstraction)) (/function.function ..statement expression archive abstraction) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/case.lux index 3a776a2a7..71e856034 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/case.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/case.lux @@ -53,18 +53,18 @@ [valueO (expression archive valueS) bodyO (expression archive bodyS)] ## TODO: Find some way to do 'let' without paying the price of the closure. - (wrap (_.apply/* (_.lambda (list (..register register)) - bodyO) - (list valueO))))) + (in (_.apply/* (_.lambda (list (..register register)) + bodyO) + (list valueO))))) (def: #export (let! statement expression archive [valueS register bodyS]) (Generator! [Synthesis Register Synthesis]) (do ///////phase.monad [valueO (expression archive valueS) bodyO (statement expression archive bodyS)] - (wrap ($_ _.then - (_.set (list (..register register)) valueO) - bodyO)))) + (in ($_ _.then + (_.set (list (..register register)) valueO) + bodyO)))) (def: #export (if expression archive [testS thenS elseS]) (Generator [Synthesis Synthesis Synthesis]) @@ -72,7 +72,7 @@ [testO (expression archive testS) thenO (expression archive thenS) elseO (expression archive elseS)] - (wrap (_.? testO thenO elseO)))) + (in (_.? testO thenO elseO)))) (def: #export (if! statement expression archive [testS thenS elseS]) (Generator! [Synthesis Synthesis Synthesis]) @@ -80,24 +80,24 @@ [test! (expression archive testS) then! (statement expression archive thenS) else! (statement expression archive elseS)] - (wrap (_.if test! - then! - else!)))) + (in (_.if test! + then! + else!)))) (def: #export (get expression archive [pathP valueS]) (Generator [(List Member) Synthesis]) (do ///////phase.monad [valueO (expression archive valueS)] - (wrap (list\fold (function (_ side source) - (.let [method (.case side - (^template [<side> <accessor>] - [(<side> lefts) - (<accessor> (_.int (.int lefts)))]) - ([#.Left //runtime.tuple::left] - [#.Right //runtime.tuple::right]))] - (method source))) - valueO - (list.reverse pathP))))) + (in (list\fold (function (_ side source) + (.let [method (.case side + (^template [<side> <accessor>] + [(<side> lefts) + (<accessor> (_.int (.int lefts)))]) + ([#.Left //runtime.tuple::left] + [#.Right //runtime.tuple::right]))] + (method source))) + valueO + (list.reverse pathP))))) (def: @savepoint (_.var "lux_pm_savepoint")) (def: @cursor (_.var "lux_pm_cursor")) @@ -187,14 +187,14 @@ (recur elseP) #.None - (wrap ..fail_pm!))] - (wrap (#.Some (.if when - (_.if ..peek - then! - else!) - (_.if ..peek - else! - then!))))) + (in ..fail_pm!))] + (in (#.Some (.if when + (_.if ..peek + then! + else!) + (_.if ..peek + else! + then!))))) (^template [<tag> <format>] [(<tag> cons) @@ -205,14 +205,14 @@ ..peek)]) (recur then))) (#.Cons cons))] - (wrap (#.Some (_.cond clauses - ..fail_pm!))))]) + (in (#.Some (_.cond clauses + ..fail_pm!))))]) ([#/////synthesis.I64_Fork (<| //primitive.i64 .int)] [#/////synthesis.F64_Fork (<| //primitive.f64)] [#/////synthesis.Text_Fork (<| //primitive.text)]) _ - (\ ///////phase.monad wrap #.None))) + (\ ///////phase.monad in #.None))) (def: (pattern_matching' in_closure? statement expression archive) (-> Bit Phase! Phase Archive Path (Operation (Statement Any))) @@ -221,7 +221,7 @@ [?output (primitive_pattern_matching recur pathP)] (.case ?output (#.Some output) - (wrap output) + (in output) #.None (.case pathP @@ -229,14 +229,14 @@ (statement expression archive bodyS) #/////synthesis.Pop - (///////phase\wrap ..pop!) + (///////phase\in ..pop!) (#/////synthesis.Bind register) - (///////phase\wrap (_.set (list (..register register)) ..peek)) + (///////phase\in (_.set (list (..register register)) ..peek)) (^template [<complex> <simple> <choice>] [(^ (<complex> idx)) - (///////phase\wrap (<choice> false idx)) + (///////phase\in (<choice> false idx)) (^ (<simple> idx nextP)) (|> nextP @@ -246,41 +246,41 @@ [/////synthesis.side/right /////synthesis.simple_right_side ..right_choice]) (^ (/////synthesis.member/left 0)) - (///////phase\wrap (|> ..peek (_.nth (_.int +0)) ..push!)) + (///////phase\in (|> ..peek (_.nth (_.int +0)) ..push!)) (^template [<pm> <getter>] [(^ (<pm> lefts)) - (///////phase\wrap (|> ..peek (<getter> (_.int (.int lefts))) ..push!))]) + (///////phase\in (|> ..peek (<getter> (_.int (.int lefts))) ..push!))]) ([/////synthesis.member/left //runtime.tuple::left] [/////synthesis.member/right //runtime.tuple::right]) (^ (/////synthesis.!bind_top register thenP)) (do ! [then! (recur thenP)] - (///////phase\wrap ($_ _.then - (_.set (list (..register register)) ..peek_and_pop) - then!))) + (///////phase\in ($_ _.then + (_.set (list (..register register)) ..peek_and_pop) + then!))) (^ (/////synthesis.!multi_pop nextP)) (.let [[extra_pops nextP'] (case.count_pops nextP)] (do ! [next! (recur nextP')] - (///////phase\wrap ($_ _.then - (..multi_pop! (n.+ 2 extra_pops)) - next!)))) + (///////phase\in ($_ _.then + (..multi_pop! (n.+ 2 extra_pops)) + next!)))) (^ (/////synthesis.path/seq preP postP)) (do ! [pre! (recur preP) post! (recur postP)] - (wrap (_.then pre! post!))) + (in (_.then pre! post!))) (^ (/////synthesis.path/alt preP postP)) (do ! [pre! (recur preP) post! (recur postP) g!once (..gensym "once")] - (wrap (..alternation in_closure? g!once pre! post!))) + (in (..alternation in_closure? g!once pre! post!))) _ (undefined)))))) @@ -290,10 +290,10 @@ (do ///////phase.monad [pattern_matching! (pattern_matching' in_closure? statement expression archive pathP) g!once (..gensym "once")] - (wrap ($_ _.then - (..with_looping in_closure? g!once - pattern_matching!) - (_.raise (_.Exception/1 (_.string case.pattern_matching_error))))))) + (in ($_ _.then + (..with_looping in_closure? g!once + pattern_matching!) + (_.raise (_.Exception/1 (_.string case.pattern_matching_error))))))) (def: #export dependencies (-> Path (List SVar)) @@ -313,11 +313,11 @@ (do ///////phase.monad [stack_init (expression archive valueS) pattern_matching! (pattern_matching in_closure? statement expression archive pathP)] - (wrap ($_ _.then - (_.set (list @cursor) (_.list (list stack_init))) - (_.set (list @savepoint) (_.list (list))) - pattern_matching! - )))) + (in ($_ _.then + (_.set (list @cursor) (_.list (list stack_init))) + (_.set (list @savepoint) (_.list (list))) + pattern_matching! + )))) (def: #export (case statement expression archive [valueS pathP]) (-> Phase! (Generator [Synthesis Path])) @@ -331,4 +331,4 @@ pattern_matching!)] _ (/////generation.execute! directive) _ (/////generation.save! case_artifact #.None directive)] - (wrap (_.apply/* @case @dependencies+)))) + (in (_.apply/* @case @dependencies+)))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/function.lux index d2e70def2..3c114a935 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/function.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/function.lux @@ -36,7 +36,7 @@ (do {! ///////phase.monad} [functionO (expression archive functionS) argsO+ (monad.map ! (expression archive) argsS+)] - (wrap (_.apply/* functionO argsO+)))) + (in (_.apply/* functionO argsO+)))) (def: #export capture (-> Register SVar) @@ -49,7 +49,7 @@ (do ///////phase.monad [_ (/////generation.execute! function_definition) _ (/////generation.save! function_id #.None function_definition)] - (wrap @function)) + (in @function)) _ (do {! ///////phase.monad} @@ -61,7 +61,7 @@ (_.return @function)))] _ (/////generation.execute! directive) _ (/////generation.save! function_id #.None directive)] - (wrap (_.apply/* @function inits))))) + (in (_.apply/* @function inits))))) (def: input (|>> inc //case.register)) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/loop.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/loop.lux index 96c1d1ce1..45dbaf999 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/loop.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/loop.lux @@ -60,9 +60,9 @@ [initsO+ (monad.map ! (expression archive) initsS+) body! (/////generation.with_anchor start (statement expression archive bodyS))] - (wrap (<| (..setup start initsO+) - ..set_scope - body!))))) + (in (<| (..setup start initsO+) + ..set_scope + body!))))) (def: #export (scope statement expression archive [start initsS+ bodyS]) (-> Phase! (Generator (Scope Synthesis))) @@ -104,7 +104,7 @@ (_.apply/* @loop foreigns)]))] _ (/////generation.execute! directive) _ (/////generation.save! loop_artifact #.None directive)] - (wrap (_.apply/* instantiation initsO+))))) + (in (_.apply/* instantiation initsO+))))) (def: #export (recur! statement expression archive argsS+) (Generator! (List Synthesis)) @@ -116,7 +116,7 @@ list.enumeration (list\map (function (_ [idx _]) (_.nth (_.int (.int idx)) @temp))))]] - (wrap ($_ _.then - (_.set (list @temp) (_.list argsO+)) - (..setup offset re_binds - _.continue))))) + (in ($_ _.then + (_.set (list @temp) (_.list argsO+)) + (..setup offset re_binds + _.continue))))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux index 26aeb7f76..440f208ba 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux @@ -113,13 +113,13 @@ body) (do {! meta.monad} [ids (monad.seq ! (list.repeat (list.size vars) meta.count))] - (wrap (list (` (let [(~+ (|> vars - (list.zipped/2 ids) - (list\map (function (_ [id var]) - (list (code.local_identifier var) - (` (_.var (~ (code.text (format "v" (%.nat id))))))))) - list.concat))] - (~ body))))))) + (in (list (` (let [(~+ (|> vars + (list.zipped/2 ids) + (list\map (function (_ [id var]) + (list (code.local_identifier var) + (` (_.var (~ (code.text (format "v" (%.nat id))))))))) + list.concat))] + (~ body))))))) (syntax: (runtime: {declaration (<>.or <code>.local_identifier (<code>.form (<>.and <code>.local_identifier @@ -131,12 +131,12 @@ (let [nameC (code.local_identifier name) code_nameC (code.local_identifier (format "@" name)) runtime_nameC (` (runtime_name (~ (code.text name))))] - (wrap (list (` (def: #export (~ nameC) SVar (~ runtime_nameC))) - (` (def: (~ code_nameC) - (Statement Any) - (..feature (~ runtime_nameC) - (function ((~ g!_) (~ g!_)) - (_.set (list (~ g!_)) (~ code)))))))))) + (in (list (` (def: #export (~ nameC) SVar (~ runtime_nameC))) + (` (def: (~ code_nameC) + (Statement Any) + (..feature (~ runtime_nameC) + (function ((~ g!_) (~ g!_)) + (_.set (list (~ g!_)) (~ code)))))))))) (#.Right [name inputs]) (macro.with_gensyms [g!_] @@ -146,16 +146,16 @@ inputsC (list\map code.local_identifier inputs) inputs_typesC (list\map (function.constant (` (_.Expression Any))) inputs)] - (wrap (list (` (def: #export ((~ nameC) (~+ inputsC)) - (-> (~+ inputs_typesC) (Computation Any)) - (_.apply/* (~ runtime_nameC) (list (~+ inputsC))))) - (` (def: (~ code_nameC) - (Statement Any) - (..feature (~ runtime_nameC) - (function ((~ g!_) (~ g!_)) - (..with_vars [(~+ inputsC)] - (_.def (~ g!_) (list (~+ inputsC)) - (~ code))))))))))))) + (in (list (` (def: #export ((~ nameC) (~+ inputsC)) + (-> (~+ inputs_typesC) (Computation Any)) + (_.apply/* (~ runtime_nameC) (list (~+ inputsC))))) + (` (def: (~ code_nameC) + (Statement Any) + (..feature (~ runtime_nameC) + (function ((~ g!_) (~ g!_)) + (..with_vars [(~+ inputsC)] + (_.def (~ g!_) (list (~+ inputsC)) + (~ code))))))))))))) (runtime: (lux::try op) (with_vars [exception] @@ -451,11 +451,11 @@ (do ///////phase.monad [_ (/////generation.execute! ..runtime) _ (/////generation.save! ..module_id #.None ..runtime)] - (wrap [(|> artifact.empty - artifact.resource - product.right) - (row.row [..module_id - #.None - (|> ..runtime - _.code - (\ utf8.codec encode))])])))) + (in [(|> artifact.empty + artifact.resource + product.right) + (row.row [..module_id + #.None + (|> ..runtime + _.code + (\ utf8.codec encode))])])))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/structure.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/structure.lux index 342e180d0..394804f3e 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/structure.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/structure.lux @@ -18,7 +18,7 @@ (Generator (Tuple Synthesis)) (case elemsS+ #.Nil - (///////phase\wrap (//primitive.text /////synthesis.unit)) + (///////phase\in (//primitive.text /////synthesis.unit)) (#.Cons singletonS #.Nil) (generate archive singletonS) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r.lux index d3636709a..80171bbfb 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r.lux @@ -30,7 +30,7 @@ (case synthesis (^template [<tag> <generator>] [(^ (<tag> value)) - (//////phase\wrap (<generator> value))]) + (//////phase\in (<generator> value))]) ([////synthesis.bit /primitive.bit] [////synthesis.i64 /primitive.i64] [////synthesis.f64 /primitive.f64] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/case.lux index 912b7aff7..1026bd0fe 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/case.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/case.lux @@ -49,10 +49,10 @@ (do ///////phase.monad [valueO (expression archive valueS) bodyO (expression archive bodyS)] - (wrap (_.block - ($_ _.then - (_.set! (..register register) valueO) - bodyO))))) + (in (_.block + ($_ _.then + (_.set! (..register register) valueO) + bodyO))))) (def: #export (if expression archive [testS thenS elseS]) (Generator [Synthesis Synthesis Synthesis]) @@ -60,22 +60,22 @@ [testO (expression archive testS) thenO (expression archive thenS) elseO (expression archive elseS)] - (wrap (_.if testO thenO elseO)))) + (in (_.if testO thenO elseO)))) (def: #export (get expression archive [pathP valueS]) (Generator [(List Member) Synthesis]) (do ///////phase.monad [valueO (expression archive valueS)] - (wrap (list\fold (function (_ side source) - (.let [method (.case side - (^template [<side> <accessor>] - [(<side> lefts) - (<accessor> (_.int (.int lefts)))]) - ([#.Left //runtime.tuple::left] - [#.Right //runtime.tuple::right]))] - (method source))) - valueO - (list.reverse pathP))))) + (in (list\fold (function (_ side source) + (.let [method (.case side + (^template [<side> <accessor>] + [(<side> lefts) + (<accessor> (_.int (.int lefts)))]) + ([#.Left //runtime.tuple::left] + [#.Right //runtime.tuple::right]))] + (method source))) + valueO + (list.reverse pathP))))) (def: $savepoint (_.var "lux_pm_cursor_savepoint")) (def: $cursor (_.var "lux_pm_cursor")) @@ -139,10 +139,10 @@ (expression archive bodyS) #/////synthesis.Pop - (///////phase\wrap ..pop_cursor!) + (///////phase\in ..pop_cursor!) (#/////synthesis.Bind register) - (///////phase\wrap (_.set! (..register register) ..peek)) + (///////phase\in (_.set! (..register register) ..peek)) (#/////synthesis.Bit_Fork when thenP elseP) (do {! ///////phase.monad} @@ -152,14 +152,14 @@ (recur elseP) #.None - (wrap ..fail!))] - (wrap (.if when - (_.if ..peek - then! - else!) - (_.if ..peek - else! - then!)))) + (in ..fail!))] + (in (.if when + (_.if ..peek + then! + else!) + (_.if ..peek + else! + then!)))) (^template [<tag> <format> <=>] [(<tag> cons) @@ -167,34 +167,34 @@ [clauses (monad.map ! (function (_ [match then]) (do ! [then! (recur then)] - (wrap [(<=> (|> match <format>) - ..peek) - then!]))) + (in [(<=> (|> match <format>) + ..peek) + then!]))) (#.Cons cons))] - (wrap (list\fold (function (_ [when then] else) - (_.if when then else)) - ..fail! - clauses)))]) + (in (list\fold (function (_ [when then] else) + (_.if when then else)) + ..fail! + clauses)))]) ([#/////synthesis.I64_Fork //primitive.i64 //runtime.i64::=] [#/////synthesis.F64_Fork //primitive.f64 _.=] [#/////synthesis.Text_Fork //primitive.text _.=]) (^template [<pm> <flag> <prep>] [(^ (<pm> idx)) - (///////phase\wrap ($_ _.then - (_.set! $temp (|> idx <prep> .int _.int (//runtime.sum::get ..peek (//runtime.flag <flag>)))) - (_.if (_.= _.null $temp) - ..fail! - (..push_cursor! $temp))))]) + (///////phase\in ($_ _.then + (_.set! $temp (|> idx <prep> .int _.int (//runtime.sum::get ..peek (//runtime.flag <flag>)))) + (_.if (_.= _.null $temp) + ..fail! + (..push_cursor! $temp))))]) ([/////synthesis.side/left false (<|)] [/////synthesis.side/right true inc]) (^ (/////synthesis.member/left 0)) - (///////phase\wrap (_.nth (_.int +1) ..peek)) + (///////phase\in (_.nth (_.int +1) ..peek)) (^template [<pm> <getter>] [(^ (<pm> lefts)) - (///////phase\wrap (|> ..peek (<getter> (_.int (.int lefts))) ..push_cursor!))]) + (///////phase\in (|> ..peek (<getter> (_.int (.int lefts))) ..push_cursor!))]) ([/////synthesis.member/left //runtime.tuple::left] [/////synthesis.member/right //runtime.tuple::right]) @@ -202,32 +202,32 @@ (do ///////phase.monad [leftO (recur leftP) rightO (recur rightP)] - (wrap ($_ _.then - leftO - rightO))) + (in ($_ _.then + leftO + rightO))) (^ (/////synthesis.path/alt leftP rightP)) (do {! ///////phase.monad} [leftO (recur leftP) rightO (recur rightP)] - (wrap (_.try ($_ _.then - ..save_cursor! - leftO) - #.None - (#.Some (..catch ($_ _.then - ..restore_cursor! - rightO))) - #.None))) + (in (_.try ($_ _.then + ..save_cursor! + leftO) + #.None + (#.Some (..catch ($_ _.then + ..restore_cursor! + rightO))) + #.None))) ))) (def: (pattern_matching expression archive pathP) (Generator Path) (do ///////phase.monad [pattern_matching! (pattern_matching' expression archive pathP)] - (wrap (_.try pattern_matching! - #.None - (#.Some (..catch (_.stop (_.string "Invalid expression for pattern-matching.")))) - #.None)))) + (in (_.try pattern_matching! + #.None + (#.Some (..catch (_.stop (_.string "Invalid expression for pattern-matching.")))) + #.None)))) (def: #export (case expression archive [valueS pathP]) (Generator [Synthesis Path]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/function.lux index f30e18def..ed2ef6a5d 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/function.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/function.lux @@ -37,7 +37,7 @@ (do {! ///////phase.monad} [functionO (expression archive functionS) argsO+ (monad.map ! (expression archive) argsS+)] - (wrap (_.apply argsO+ functionO)))) + (in (_.apply argsO+ functionO)))) (def: (with_closure function_id $function inits function_definition) (-> artifact.ID SVar (List Expression) Expression (Operation Expression)) @@ -47,7 +47,7 @@ [_ (/////generation.execute! function_definition) _ (/////generation.save! (%.nat function_id) function_definition)] - (wrap $function)) + (in $function)) _ (do ///////phase.monad @@ -61,7 +61,7 @@ $function)))] _ (/////generation.execute! closure_definition) _ (/////generation.save! (%.nat function_id) closure_definition)] - (wrap (_.apply inits $function))))) + (in (_.apply inits $function))))) (def: $curried (_.var "curried")) (def: $missing (_.var "missing")) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/loop.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/loop.lux index f4887aaaa..84d61fb44 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/loop.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/loop.lux @@ -47,19 +47,19 @@ initsO+ (monad.map ! (expression archive) initsS+) bodyO (/////generation.with_anchor $scope (expression archive bodyS))] - (wrap (_.block - ($_ _.then - (_.set! $scope - (_.function (|> initsS+ - list.size - list.indices - (list\map (|>> (n.+ offset) //case.register))) - bodyO)) - (_.apply initsO+ $scope))))))) + (in (_.block + ($_ _.then + (_.set! $scope + (_.function (|> initsS+ + list.size + list.indices + (list\map (|>> (n.+ offset) //case.register))) + bodyO)) + (_.apply initsO+ $scope))))))) (def: #export (recur expression archive argsS+) (Generator (List Synthesis)) (do {! ///////phase.monad} [$scope /////generation.anchor argsO+ (monad.map ! (expression archive) argsS+)] - (wrap (_.apply argsO+ $scope)))) + (in (_.apply argsO+ $scope)))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/procedure/common.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/procedure/common.lux index f646f82cd..557d5b572 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/procedure/common.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/procedure/common.lux @@ -35,7 +35,7 @@ (Dict Text Proc)) (syntax: (Vector {size s.nat} elemT) - (wrap (list (` [(~+ (list.repeat size elemT))])))) + (in (list (` [(~+ (list.repeat size elemT))])))) (type: #export Nullary (-> (Vector +0 Expression) Expression)) (type: #export Unary (-> (Vector +1 Expression) Expression)) @@ -66,7 +66,7 @@ (with-gensyms [g!_ g!proc g!name g!translate g!inputs] (do {@ macro.monad} [g!input+ (monad.seq @ (list.repeat arity (macro.gensym "input")))] - (wrap (list (` (def: #export ((~ (code.local-identifier name)) (~ g!proc)) + (in (list (` (def: #export ((~ (code.local-identifier name)) (~ g!proc)) (-> (-> (..Vector (~ (code.nat arity)) Expression) Expression) (-> Text ..Proc)) (function ((~ g!_) (~ g!name)) @@ -78,7 +78,7 @@ (list/map (function (_ g!input) (list g!input (` ((~ g!translate) (~ g!input)))))) list.concat))] - ((~' wrap) ((~ g!proc) [(~+ g!input+)]))) + ((~' in) ((~ g!proc) [(~+ g!input+)]))) (~' _) (macro.failure (wrong-arity (~ g!name) +1 (list.size (~ g!inputs)))))))))))))) @@ -94,7 +94,7 @@ (function (_ translate inputsS) (do {@ macro.Monad<Meta>} [inputsI (monad.map @ translate inputsS)] - (wrap (proc inputsI)))))) + (in (proc inputsI)))))) ## [Procedures] ## [[Lux]] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/procedure/host.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/procedure/host.lux index 5dabf7f2a..74dc0231e 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/procedure/host.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/procedure/host.lux @@ -28,7 +28,7 @@ ## (^ (list [_ (#.Text name)])) ## (do macro.Monad<Meta> ## [] -## (wrap name)) +## (in name)) ## _ ## (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs)))) @@ -40,7 +40,7 @@ ## (do {@ macro.Monad<Meta>} ## [functionO (translate functionS) ## argsO+ (monad.map @ translate argsS+)] -## (wrap (lua.apply functionO argsO+))) +## (in (lua.apply functionO argsO+))) ## _ ## (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs)))) @@ -60,7 +60,7 @@ ## (do {@ macro.Monad<Meta>} ## [tableO (translate tableS) ## argsO+ (monad.map @ translate argsS+)] -## (wrap (lua.method field tableO argsO+))) +## (in (lua.method field tableO argsO+))) ## _ ## (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs)))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/runtime.lux index 017a7a547..2fbaa82f3 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/runtime.lux @@ -80,13 +80,13 @@ body) (do {! meta.monad} [ids (monad.seq ! (list.repeat (list.size vars) meta.count))] - (wrap (list (` (let [(~+ (|> vars - (list.zipped/2 ids) - (list\map (function (_ [id var]) - (list (code.local_identifier var) - (` (_.var (~ (code.text (format "v" (%.nat id))))))))) - list.concat))] - (~ body))))))) + (in (list (` (let [(~+ (|> vars + (list.zipped/2 ids) + (list\map (function (_ [id var]) + (list (code.local_identifier var) + (` (_.var (~ (code.text (format "v" (%.nat id))))))))) + list.concat))] + (~ body))))))) (syntax: (runtime: {declaration (<>.or <code>.local_identifier (<code>.form (<>.and <code>.local_identifier @@ -100,29 +100,29 @@ (case declaration (#.Left name) (let [g!name (code.local_identifier name)] - (wrap (list (` (def: #export (~ g!name) - _.SVar - (~ runtime_name))) - - (` (def: (~ (code.local_identifier (format "@" name))) - _.Expression - (_.set! (~ runtime_name) (~ code))))))) + (in (list (` (def: #export (~ g!name) + _.SVar + (~ runtime_name))) + + (` (def: (~ (code.local_identifier (format "@" name))) + _.Expression + (_.set! (~ runtime_name) (~ code))))))) (#.Right [name inputs]) (let [g!name (code.local_identifier name) inputsC (list\map code.local_identifier inputs) inputs_typesC (list\map (function.constant (` _.Expression)) inputs)] - (wrap (list (` (def: #export ((~ g!name) (~+ inputsC)) - (-> (~+ inputs_typesC) _.Expression) - (_.apply (list (~+ inputsC)) (~ runtime_name)))) + (in (list (` (def: #export ((~ g!name) (~+ inputsC)) + (-> (~+ inputs_typesC) _.Expression) + (_.apply (list (~+ inputsC)) (~ runtime_name)))) - (` (def: (~ (code.local_identifier (format "@" name))) - _.Expression - (..with_vars [(~+ inputsC)] - (_.set! (~ runtime_name) - (_.function (list (~+ inputsC)) - (~ code)))))))))))))) + (` (def: (~ (code.local_identifier (format "@" name))) + _.Expression + (..with_vars [(~+ inputsC)] + (_.set! (~ runtime_name) + (_.function (list (~+ inputsC)) + (~ code)))))))))))))) (def: #export variant_tag_field "luxVT") (def: #export variant_flag_field "luxVF") @@ -846,10 +846,10 @@ (do ///////phase.monad [_ (/////generation.execute! ..runtime) _ (/////generation.save! (%.nat ..module_id) ..runtime)] - (wrap [(|> artifact.empty - artifact.resource - product.right) - (row.row [(%.nat ..module_id) - (|> ..runtime - _.code - (\ utf8.codec encode))])]))) + (in [(|> artifact.empty + artifact.resource + product.right) + (row.row [(%.nat ..module_id) + (|> ..runtime + _.code + (\ utf8.codec encode))])]))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/structure.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/structure.lux index 1020cad97..1853aa963 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/structure.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/structure.lux @@ -21,7 +21,7 @@ (Generator (Tuple Synthesis)) (case elemsS+ #.Nil - (///////phase\wrap (//primitive.text /////synthesis.unit)) + (///////phase\in (//primitive.text /////synthesis.unit)) (#.Cons singletonS #.Nil) (expression archive singletonS) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/reference.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/reference.lux index 8b2a907ca..f3643d685 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/reference.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/reference.lux @@ -86,4 +86,4 @@ (..constant system archive value) (#reference.Variable value) - (phase\wrap (..variable system value)))) + (phase\in (..variable system value)))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby.lux index c891727e4..f4c393a19 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby.lux @@ -66,7 +66,7 @@ (case synthesis (^template [<tag> <generator>] [(^ (<tag> value)) - (//////phase\wrap (<generator> value))]) + (//////phase\in (<generator> value))]) ([////synthesis.bit /primitive.bit] [////synthesis.i64 /primitive.i64] [////synthesis.f64 /primitive.f64] @@ -92,7 +92,7 @@ [////synthesis.function/abstraction /function.function]) (^ (////synthesis.loop/recur _)) - (//////phase.throw ..cannot-recur-as-an-expression []) + (//////phase.except ..cannot-recur-as-an-expression []) (#////synthesis.Reference value) (//reference.reference /reference.system archive value) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/case.lux index 3c080ba8a..edb00ae21 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/case.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/case.lux @@ -54,19 +54,19 @@ [valueO (expression archive valueS) bodyO (expression archive bodyS)] ## TODO: Find some way to do 'let' without paying the price of the closure. - (wrap (|> bodyO - _.return - (_.lambda #.None (list (..register register))) - (_.apply_lambda/* (list valueO)))))) + (in (|> bodyO + _.return + (_.lambda #.None (list (..register register))) + (_.apply_lambda/* (list valueO)))))) (def: #export (let! statement expression archive [valueS register bodyS]) (Generator! [Synthesis Register Synthesis]) (do ///////phase.monad [valueO (expression archive valueS) bodyO (statement expression archive bodyS)] - (wrap ($_ _.then - (_.set (list (..register register)) valueO) - bodyO)))) + (in ($_ _.then + (_.set (list (..register register)) valueO) + bodyO)))) (def: #export (if expression archive [testS thenS elseS]) (Generator [Synthesis Synthesis Synthesis]) @@ -74,7 +74,7 @@ [testO (expression archive testS) thenO (expression archive thenS) elseO (expression archive elseS)] - (wrap (_.? testO thenO elseO)))) + (in (_.? testO thenO elseO)))) (def: #export (if! statement expression archive [testS thenS elseS]) (Generator! [Synthesis Synthesis Synthesis]) @@ -82,24 +82,24 @@ [test! (expression archive testS) then! (statement expression archive thenS) else! (statement expression archive elseS)] - (wrap (_.if test! - then! - else!)))) + (in (_.if test! + then! + else!)))) (def: #export (get expression archive [pathP valueS]) (Generator [(List Member) Synthesis]) (do ///////phase.monad [valueO (expression archive valueS)] - (wrap (list\fold (function (_ side source) - (.let [method (.case side - (^template [<side> <accessor>] - [(<side> lefts) - (<accessor> (_.int (.int lefts)))]) - ([#.Left //runtime.tuple//left] - [#.Right //runtime.tuple//right]))] - (method source))) - valueO - (list.reverse pathP))))) + (in (list\fold (function (_ side source) + (.let [method (.case side + (^template [<side> <accessor>] + [(<side> lefts) + (<accessor> (_.int (.int lefts)))]) + ([#.Left //runtime.tuple//left] + [#.Right //runtime.tuple//right]))] + (method source))) + valueO + (list.reverse pathP))))) (def: @savepoint (_.local "lux_pm_savepoint")) (def: @cursor (_.local "lux_pm_cursor")) @@ -196,14 +196,14 @@ (recur elseP) #.None - (wrap ..fail!))] - (wrap (#.Some (.if when - (_.if ..peek - then! - else!) - (_.if ..peek - else! - then!))))) + (in ..fail!))] + (in (#.Some (.if when + (_.if ..peek + then! + else!) + (_.if ..peek + else! + then!))))) (^template [<tag> <format>] [(<tag> cons) @@ -214,14 +214,14 @@ ..peek)]) (recur then))) (#.Cons cons))] - (wrap (#.Some (_.cond clauses - ..fail!))))]) + (in (#.Some (_.cond clauses + ..fail!))))]) ([#/////synthesis.I64_Fork (<| //primitive.i64 .int)] [#/////synthesis.F64_Fork (<| //primitive.f64)] [#/////synthesis.Text_Fork (<| //primitive.text)]) _ - (\ ///////phase.monad wrap #.None))) + (\ ///////phase.monad in #.None))) (def: (pattern_matching' in_closure? statement expression archive) (-> Bit (Generator! Path)) @@ -230,7 +230,7 @@ [?output (primitive_pattern_matching recur pathP)] (.case ?output (#.Some output) - (wrap output) + (in output) #.None (.case pathP @@ -238,10 +238,10 @@ (statement expression archive bodyS) #/////synthesis.Pop - (///////phase\wrap ..pop!) + (///////phase\in ..pop!) (#/////synthesis.Bind register) - (///////phase\wrap (_.set (list (..register register)) ..peek)) + (///////phase\in (_.set (list (..register register)) ..peek)) (#/////synthesis.Bit_Fork when thenP elseP) (do {! ///////phase.monad} @@ -251,14 +251,14 @@ (recur elseP) #.None - (wrap ..fail!))] - (wrap (.if when - (_.if ..peek - then! - else!) - (_.if ..peek - else! - then!)))) + (in ..fail!))] + (in (.if when + (_.if ..peek + then! + else!) + (_.if ..peek + else! + then!)))) (^template [<tag> <format>] [(<tag> cons) @@ -269,15 +269,15 @@ ..peek)]) (recur then))) (#.Cons cons))] - (wrap (_.cond clauses - ..fail!)))]) + (in (_.cond clauses + ..fail!)))]) ([#/////synthesis.I64_Fork (<| //primitive.i64 .int)] [#/////synthesis.F64_Fork (<| //primitive.f64)] [#/////synthesis.Text_Fork (<| //primitive.text)]) (^template [<complex> <simple> <choice>] [(^ (<complex> idx)) - (///////phase\wrap (<choice> false idx)) + (///////phase\in (<choice> false idx)) (^ (<simple> idx nextP)) (|> nextP @@ -287,36 +287,36 @@ [/////synthesis.side/right /////synthesis.simple_right_side ..right_choice]) (^ (/////synthesis.member/left 0)) - (///////phase\wrap (|> ..peek (_.nth (_.int +0)) ..push!)) + (///////phase\in (|> ..peek (_.nth (_.int +0)) ..push!)) (^template [<pm> <getter>] [(^ (<pm> lefts)) - (///////phase\wrap (|> ..peek (<getter> (_.int (.int lefts))) ..push!))]) + (///////phase\in (|> ..peek (<getter> (_.int (.int lefts))) ..push!))]) ([/////synthesis.member/left //runtime.tuple//left] [/////synthesis.member/right //runtime.tuple//right]) (^ (/////synthesis.!bind_top register thenP)) (do ///////phase.monad [then! (recur thenP)] - (///////phase\wrap ($_ _.then - (_.set (list (..register register)) ..peek_and_pop) - then!))) + (///////phase\in ($_ _.then + (_.set (list (..register register)) ..peek_and_pop) + then!))) (^ (/////synthesis.!multi_pop nextP)) (.let [[extra_pops nextP'] (case.count_pops nextP)] (do ///////phase.monad [next! (recur nextP')] - (///////phase\wrap ($_ _.then - (..multi_pop! (n.+ 2 extra_pops)) - next!)))) + (///////phase\in ($_ _.then + (..multi_pop! (n.+ 2 extra_pops)) + next!)))) (^ (/////synthesis.path/seq preP postP)) (do ///////phase.monad [pre! (recur preP) post! (recur postP)] - (wrap ($_ _.then - pre! - post!))) + (in ($_ _.then + pre! + post!))) (^ (/////synthesis.path/alt preP postP)) (do ///////phase.monad @@ -324,7 +324,7 @@ post! (recur postP) g!once (..gensym "once") g!continue? (..gensym "continue")] - (wrap (..alternation in_closure? g!once g!continue? pre! post!))) + (in (..alternation in_closure? g!once g!continue? pre! post!))) _ (undefined)))))) @@ -335,21 +335,21 @@ [pattern_matching! (pattern_matching' in_closure? statement expression archive pathP) g!once (..gensym "once") g!continue? (..gensym "continue")] - (wrap ($_ _.then - (..with_looping in_closure? g!once g!continue? - pattern_matching!) - (_.statement (_.raise (_.string case.pattern_matching_error))))))) + (in ($_ _.then + (..with_looping in_closure? g!once g!continue? + pattern_matching!) + (_.statement (_.raise (_.string case.pattern_matching_error))))))) (def: #export (case! in_closure? statement expression archive [valueS pathP]) (-> Bit (Generator! [Synthesis Path])) (do ///////phase.monad [stack_init (expression archive valueS) pattern_matching! (pattern_matching in_closure? statement expression archive pathP)] - (wrap ($_ _.then - (_.set (list @cursor) (_.array (list stack_init))) - (_.set (list @savepoint) (_.array (list))) - pattern_matching! - )))) + (in ($_ _.then + (_.set (list @cursor) (_.array (list stack_init))) + (_.set (list @savepoint) (_.array (list))) + pattern_matching! + )))) (def: #export (case statement expression archive case) (-> Phase! (Generator [Synthesis Path])) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux index c24efad81..eae79b459 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux @@ -36,7 +36,7 @@ (do {! ///////phase.monad} [functionO (expression archive functionS) argsO+ (monad.map ! (expression archive) argsS+)] - (wrap (_.apply_lambda/* argsO+ functionO)))) + (in (_.apply_lambda/* argsO+ functionO)))) (def: #export capture (-> Register LVar) @@ -109,4 +109,4 @@ )))] _ (/////generation.execute! declaration) _ (/////generation.save! function_artifact #.None declaration)] - (wrap instatiation))) + (in instatiation))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/loop.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/loop.lux index c1639df6a..14f55ae91 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/loop.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/loop.lux @@ -61,9 +61,9 @@ [initsO+ (monad.map ! (expression archive) initsS+) body! (/////generation.with_anchor start (statement expression archive bodyS))] - (wrap (<| (..setup start initsO+) - ..with_scope - body!))))) + (in (<| (..setup start initsO+) + ..with_scope + body!))))) (def: #export (scope statement expression archive [start initsS+ bodyS]) (-> Phase! (Generator (Scope Synthesis))) @@ -76,9 +76,9 @@ _ (do {! ///////phase.monad} [body! (scope! statement expression archive [start initsS+ bodyS])] - (wrap (|> body! - (_.lambda #.None (list)) - (_.apply_lambda/* (list))))))) + (in (|> body! + (_.lambda #.None (list)) + (_.apply_lambda/* (list))))))) (def: #export (recur! statement expression archive argsS+) (Generator! (List Synthesis)) @@ -90,7 +90,7 @@ list.enumeration (list\map (function (_ [idx _]) (_.nth (_.int (.int idx)) @temp))))]] - (wrap ($_ _.then - (_.set (list @temp) (_.array argsO+)) - (..setup offset re_binds - _.next))))) + (in ($_ _.then + (_.set (list @temp) (_.array argsO+)) + (..setup offset re_binds + _.next))))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux index 9e4f78b29..1a19be4a3 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux @@ -75,13 +75,13 @@ body) (do {! meta.monad} [ids (monad.seq ! (list.repeat (list.size vars) meta.count))] - (wrap (list (` (let [(~+ (|> vars - (list.zipped/2 ids) - (list\map (function (_ [id var]) - (list (code.local_identifier var) - (` (_.local (~ (code.text (format "v" (%.nat id))))))))) - list.concat))] - (~ body))))))) + (in (list (` (let [(~+ (|> vars + (list.zipped/2 ids) + (list\map (function (_ [id var]) + (list (code.local_identifier var) + (` (_.local (~ (code.text (format "v" (%.nat id))))))))) + list.concat))] + (~ body))))))) (def: module_id 0) @@ -99,12 +99,12 @@ (#.Left name) (macro.with_gensyms [g!_] (let [g!name (code.local_identifier name)] - (wrap (list (` (def: #export (~ g!name) LVar (~ runtime_name))) - (` (def: (~ (code.local_identifier (format "@" name))) - Statement - (..feature (~ runtime_name) - (function ((~ g!_) (~ g!name)) - (_.set (list (~ g!name)) (~ code)))))))))) + (in (list (` (def: #export (~ g!name) LVar (~ runtime_name))) + (` (def: (~ (code.local_identifier (format "@" name))) + Statement + (..feature (~ runtime_name) + (function ((~ g!_) (~ g!name)) + (_.set (list (~ g!name)) (~ code)))))))))) (#.Right [name inputs]) (macro.with_gensyms [g!_] @@ -112,17 +112,17 @@ inputsC (list\map code.local_identifier inputs) inputs_typesC (list\map (function.constant (` _.Expression)) inputs)] - (wrap (list (` (def: #export ((~ g!name) (~+ inputsC)) - (-> (~+ inputs_typesC) Computation) - (_.apply/* (list (~+ inputsC)) (~ runtime_name)))) - - (` (def: (~ (code.local_identifier (format "@" name))) - Statement - (..feature (~ runtime_name) - (function ((~ g!_) (~ g!_)) - (..with_vars [(~+ inputsC)] - (_.function (~ g!_) (list (~+ inputsC)) - (~ code)))))))))))))))) + (in (list (` (def: #export ((~ g!name) (~+ inputsC)) + (-> (~+ inputs_typesC) Computation) + (_.apply/* (list (~+ inputsC)) (~ runtime_name)))) + + (` (def: (~ (code.local_identifier (format "@" name))) + Statement + (..feature (~ runtime_name) + (function ((~ g!_) (~ g!_)) + (..with_vars [(~+ inputsC)] + (_.function (~ g!_) (list (~+ inputsC)) + (~ code)))))))))))))))) (def: tuple_size (_.the "length")) @@ -394,11 +394,11 @@ (do ///////phase.monad [_ (/////generation.execute! ..runtime) _ (/////generation.save! ..module_id #.None ..runtime)] - (wrap [(|> artifact.empty - artifact.resource - product.right) - (row.row [..module_id - #.None - (|> ..runtime - _.code - (\ utf8.codec encode))])]))) + (in [(|> artifact.empty + artifact.resource + product.right) + (row.row [..module_id + #.None + (|> ..runtime + _.code + (\ utf8.codec encode))])]))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/structure.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/structure.lux index c172b43b8..e5d1da1ea 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/structure.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/structure.lux @@ -18,7 +18,7 @@ (Generator (Tuple Synthesis)) (case elemsS+ #.Nil - (///////phase\wrap (//primitive.text /////synthesis.unit)) + (///////phase\in (//primitive.text /////synthesis.unit)) (#.Cons singletonS #.Nil) (generate archive singletonS) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme.lux index 98f7b88bb..6292d9686 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme.lux @@ -30,7 +30,7 @@ (case synthesis (^template [<tag> <generator>] [(^ (<tag> value)) - (//////phase\wrap (<generator> value))]) + (//////phase\in (<generator> value))]) ([////synthesis.bit /primitive.bit] [////synthesis.i64 /primitive.i64] [////synthesis.f64 /primitive.f64] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/case.lux index 99d115b9d..43409b31d 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/case.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/case.lux @@ -49,8 +49,8 @@ (do ///////phase.monad [valueO (expression archive valueS) bodyO (expression archive bodyS)] - (wrap (_.let (list [(..register register) valueO]) - bodyO)))) + (in (_.let (list [(..register register) valueO]) + bodyO)))) (def: #export (if expression archive [testS thenS elseS]) (Generator [Synthesis Synthesis Synthesis]) @@ -58,22 +58,22 @@ [testO (expression archive testS) thenO (expression archive thenS) elseO (expression archive elseS)] - (wrap (_.if testO thenO elseO)))) + (in (_.if testO thenO elseO)))) (def: #export (get expression archive [pathP valueS]) (Generator [(List Member) Synthesis]) (do ///////phase.monad [valueO (expression archive valueS)] - (wrap (list\fold (function (_ side source) - (.let [method (.case side - (^template [<side> <accessor>] - [(<side> lefts) - (<accessor> (_.int (.int lefts)))]) - ([#.Left //runtime.tuple//left] - [#.Right //runtime.tuple//right]))] - (method source))) - valueO - (list.reverse pathP))))) + (in (list\fold (function (_ side source) + (.let [method (.case side + (^template [<side> <accessor>] + [(<side> lefts) + (<accessor> (_.int (.int lefts)))]) + ([#.Left //runtime.tuple//left] + [#.Right //runtime.tuple//right]))] + (method source))) + valueO + (list.reverse pathP))))) (def: @savepoint (_.var "lux_pm_cursor_savepoint")) (def: @cursor (_.var "lux_pm_cursor")) @@ -133,10 +133,10 @@ (expression archive bodyS) #/////synthesis.Pop - (///////phase\wrap pop_cursor!) + (///////phase\in pop_cursor!) (#/////synthesis.Bind register) - (///////phase\wrap (_.define_constant (..register register) ..peek)) + (///////phase\in (_.define_constant (..register register) ..peek)) (#/////synthesis.Bit_Fork when thenP elseP) (do {! ///////phase.monad} @@ -146,14 +146,14 @@ (recur elseP) #.None - (wrap ..fail!))] - (wrap (.if when - (_.if ..peek - then! - else!) - (_.if ..peek - else! - then!)))) + (in ..fail!))] + (in (.if when + (_.if ..peek + then! + else!) + (_.if ..peek + else! + then!)))) (^template [<tag> <format> <=>] [(<tag> cons) @@ -161,33 +161,33 @@ [clauses (monad.map ! (function (_ [match then]) (do ! [then! (recur then)] - (wrap [(<=> (|> match <format>) - ..peek) - then!]))) + (in [(<=> (|> match <format>) + ..peek) + then!]))) (#.Cons cons))] - (wrap (list\fold (function (_ [when then] else) - (_.if when then else)) - ..fail! - clauses)))]) + (in (list\fold (function (_ [when then] else) + (_.if when then else)) + ..fail! + clauses)))]) ([#/////synthesis.I64_Fork //primitive.i64 _.=/2] [#/////synthesis.F64_Fork //primitive.f64 _.=/2] [#/////synthesis.Text_Fork //primitive.text _.string=?/2]) (^template [<pm> <flag> <prep>] [(^ (<pm> idx)) - (///////phase\wrap (_.let (list [@temp (|> idx <prep> .int _.int (//runtime.sum//get ..peek (_.bool <flag>)))]) - (_.if (_.null?/1 @temp) - ..fail! - (push_cursor! @temp))))]) + (///////phase\in (_.let (list [@temp (|> idx <prep> .int _.int (//runtime.sum//get ..peek (_.bool <flag>)))]) + (_.if (_.null?/1 @temp) + ..fail! + (push_cursor! @temp))))]) ([/////synthesis.side/left false (<|)] [/////synthesis.side/right true inc]) (^ (/////synthesis.member/left 0)) - (///////phase\wrap (..push_cursor! (_.vector-ref/2 ..peek (_.int +0)))) + (///////phase\in (..push_cursor! (_.vector-ref/2 ..peek (_.int +0)))) (^template [<pm> <getter>] [(^ (<pm> lefts)) - (///////phase\wrap (|> ..peek (<getter> (_.int (.int lefts))) ..push_cursor!))]) + (///////phase\in (|> ..peek (<getter> (_.int (.int lefts))) ..push_cursor!))]) ([/////synthesis.member/left //runtime.tuple//left] [/////synthesis.member/right //runtime.tuple//right]) @@ -195,17 +195,17 @@ (do ///////phase.monad [leftO (recur leftP) rightO (recur rightP)] - (wrap (_.begin (list leftO - rightO)))) + (in (_.begin (list leftO + rightO)))) (^ (/////synthesis.path/alt leftP rightP)) (do {! ///////phase.monad} [leftO (recur leftP) rightO (recur rightP)] - (wrap (try_pm (_.begin (list restore_cursor! - rightO)) - (_.begin (list save_cursor! - leftO))))) + (in (try_pm (_.begin (list restore_cursor! + rightO)) + (_.begin (list save_cursor! + leftO))))) ))) (def: (pattern_matching expression archive pathP) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/extension/common.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/extension/common.lux index 0275e8cd9..74362d6ad 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/extension/common.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/extension/common.lux @@ -29,7 +29,7 @@ ["#." synthesis (#+ Synthesis)]]]]) (syntax: (Vector {size s.nat} elemT) - (wrap (list (` [(~+ (list.repeat size elemT))])))) + (in (list (` [(~+ (list.repeat size elemT))])))) (type: #export Nullary (-> (Vector 0 Expression) Computation)) (type: #export Unary (-> (Vector 1 Expression) Computation)) @@ -39,23 +39,23 @@ (syntax: (arity: {name s.local-identifier} {arity s.nat}) (with-gensyms [g!_ g!extension g!name g!phase g!inputs] - (do {! macro.monad} - [g!input+ (monad.seq ! (list.repeat arity (macro.gensym "input")))] - (wrap (list (` (def: #export ((~ (code.local-identifier name)) (~ g!extension)) - (-> (-> (..Vector (~ (code.nat arity)) Expression) Computation) - Handler) - (function ((~ g!_) (~ g!name) (~ g!phase) (~ g!inputs)) - (case (~ g!inputs) - (^ (list (~+ g!input+))) - (do /////.monad - [(~+ (|> g!input+ - (list\map (function (_ g!input) - (list g!input (` ((~ g!phase) (~ g!input)))))) - list.concat))] - ((~' wrap) ((~ g!extension) [(~+ g!input+)]))) - - (~' _) - (/////.throw /////extension.incorrect-arity [(~ g!name) 1 (list.size (~ g!inputs))])))))))))) + (do {! macro.monad} + [g!input+ (monad.seq ! (list.repeat arity (macro.gensym "input")))] + (in (list (` (def: #export ((~ (code.local-identifier name)) (~ g!extension)) + (-> (-> (..Vector (~ (code.nat arity)) Expression) Computation) + Handler) + (function ((~ g!_) (~ g!name) (~ g!phase) (~ g!inputs)) + (case (~ g!inputs) + (^ (list (~+ g!input+))) + (do /////.monad + [(~+ (|> g!input+ + (list\map (function (_ g!input) + (list g!input (` ((~ g!phase) (~ g!input)))))) + list.concat))] + ((~' in) ((~ g!extension) [(~+ g!input+)]))) + + (~' _) + (/////.except /////extension.incorrect-arity [(~ g!name) 1 (list.size (~ g!inputs))])))))))))) (arity: nullary 0) (arity: unary 1) @@ -68,7 +68,7 @@ (function (_ phase inputsS) (do {! /////.monad} [inputsI (monad.map ! phase inputsS)] - (wrap (extension inputsI)))))) + (in (extension inputsI)))))) (def: bundle::lux Bundle diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/function.lux index b12ddcde3..dbf2c47b9 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/function.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/function.lux @@ -34,7 +34,7 @@ (do {! ///////phase.monad} [functionO (expression archive functionS) argsO+ (monad.map ! (expression archive) argsS+)] - (wrap (_.apply/* argsO+ functionO)))) + (in (_.apply/* argsO+ functionO)))) (def: capture (-> Register Var) @@ -42,7 +42,7 @@ (def: (with_closure inits function_definition) (-> (List Expression) Computation (Operation Computation)) - (///////phase\wrap + (///////phase\in (case inits #.Nil function_definition diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/loop.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/loop.lux index 23718bfc5..3010bf016 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/loop.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/loop.lux @@ -49,16 +49,16 @@ [initsO+ (monad.map ! (expression archive) initsS+) bodyO (/////generation.with_anchor @scope (expression archive bodyS))] - (wrap (_.letrec (list [@scope (_.lambda [(|> initsS+ - list.enumeration - (list\map (|>> product.left (n.+ start) //case.register))) - #.None] - bodyO)]) - (_.apply/* initsO+ @scope)))))) + (in (_.letrec (list [@scope (_.lambda [(|> initsS+ + list.enumeration + (list\map (|>> product.left (n.+ start) //case.register))) + #.None] + bodyO)]) + (_.apply/* initsO+ @scope)))))) (def: #export (recur expression archive argsS+) (Generator (List Synthesis)) (do {! ///////phase.monad} [@scope /////generation.anchor argsO+ (monad.map ! (expression archive) argsS+)] - (wrap (_.apply/* argsO+ @scope)))) + (in (_.apply/* argsO+ @scope)))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/runtime.lux index f383839f3..de05f8c6e 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/runtime.lux @@ -62,13 +62,13 @@ body) (do {! meta.monad} [ids (monad.seq ! (list.repeat (list.size vars) meta.count))] - (wrap (list (` (let [(~+ (|> vars - (list.zipped/2 ids) - (list\map (function (_ [id var]) - (list (code.local_identifier var) - (` (_.var (~ (code.text (format "v" (%.nat id))))))))) - list.concat))] - (~ body))))))) + (in (list (` (let [(~+ (|> vars + (list.zipped/2 ids) + (list\map (function (_ [id var]) + (list (code.local_identifier var) + (` (_.var (~ (code.text (format "v" (%.nat id))))))))) + list.concat))] + (~ body))))))) (syntax: (runtime: {declaration (<>.or <code>.local_identifier (<code>.form (<>.and <code>.local_identifier @@ -82,28 +82,28 @@ (case declaration (#.Left name) (let [g!name (code.local_identifier name)] - (wrap (list (` (def: #export (~ g!name) - Var - (~ runtime_name))) - - (` (def: (~ (code.local_identifier (format "@" name))) - _.Computation - (_.define_constant (~ runtime_name) (~ code))))))) + (in (list (` (def: #export (~ g!name) + Var + (~ runtime_name))) + + (` (def: (~ (code.local_identifier (format "@" name))) + _.Computation + (_.define_constant (~ runtime_name) (~ code))))))) (#.Right [name inputs]) (let [g!name (code.local_identifier name) inputsC (list\map code.local_identifier inputs) inputs_typesC (list\map (function.constant (` _.Expression)) inputs)] - (wrap (list (` (def: #export ((~ g!name) (~+ inputsC)) - (-> (~+ inputs_typesC) _.Computation) - (_.apply/* (list (~+ inputsC)) (~ runtime_name)))) + (in (list (` (def: #export ((~ g!name) (~+ inputsC)) + (-> (~+ inputs_typesC) _.Computation) + (_.apply/* (list (~+ inputsC)) (~ runtime_name)))) - (` (def: (~ (code.local_identifier (format "@" name))) - _.Computation - (..with_vars [(~+ inputsC)] - (_.define_function (~ runtime_name) [(list (~+ inputsC)) #.None] - (~ code))))))))))))) + (` (def: (~ (code.local_identifier (format "@" name))) + _.Computation + (..with_vars [(~+ inputsC)] + (_.define_function (~ runtime_name) [(list (~+ inputsC)) #.None] + (~ code))))))))))))) (def: last_index (-> Expression Computation) @@ -361,10 +361,10 @@ (do ///////phase.monad [_ (/////generation.execute! ..runtime) _ (/////generation.save! (%.nat ..module_id) ..runtime)] - (wrap [(|> artifact.empty - artifact.resource - product.right) - (row.row [(%.nat ..module_id) - (|> ..runtime - _.code - (\ utf8.codec encode))])]))) + (in [(|> artifact.empty + artifact.resource + product.right) + (row.row [(%.nat ..module_id) + (|> ..runtime + _.code + (\ utf8.codec encode))])]))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/structure.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/structure.lux index 50a8357f7..46237d2a2 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/structure.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/structure.lux @@ -21,7 +21,7 @@ (Generator (Tuple Synthesis)) (case elemsS+ #.Nil - (///////phase\wrap (//primitive.text /////synthesis.unit)) + (///////phase\in (//primitive.text /////synthesis.unit)) (#.Cons singletonS #.Nil) (expression archive singletonS) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis.lux index 47260c0fc..306dfc48a 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis.lux @@ -50,10 +50,10 @@ (function (optimization' analysis) (case analysis (#///analysis.Primitive analysis') - (phase\wrap (#/.Primitive (..primitive analysis'))) + (phase\in (#/.Primitive (..primitive analysis'))) (#///analysis.Reference reference) - (phase\wrap (#/.Reference reference)) + (phase\in (#/.Reference reference)) (#///analysis.Structure structure) (/.with_currying? false @@ -61,7 +61,7 @@ (#///analysis.Variant variant) (do phase.monad [valueS (optimization' (get@ #///analysis.value variant))] - (wrap (/.variant (set@ #///analysis.value valueS variant)))) + (in (/.variant (set@ #///analysis.value valueS variant)))) (#///analysis.Tuple tuple) (|> tuple diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/case.lux index e0f9ea89e..d004e97ef 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/case.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/case.lux @@ -228,7 +228,7 @@ (do {! ///.monad} [headSP (path archive synthesize headP headA) tailSP+ (monad.map ! (product.uncurry (path archive synthesize)) tailPA+)] - (wrap (/.branch/case [input (list\fold weave headSP tailSP+)])))) + (in (/.branch/case [input (list\fold weave headSP tailSP+)])))) (template: (!masking <variable> <output>) [[(#///analysis.Bind <variable>) @@ -240,12 +240,12 @@ (do ///.monad [body (/.with_new_local (synthesize archive body))] - (wrap (/.branch/let [input @variable body])))) + (in (/.branch/let [input @variable body])))) (def: #export (synthesize_masking synthesize archive input @variable @output) (-> Phase Archive Synthesis Register Register (Operation Synthesis)) (if (n.= @variable @output) - (///\wrap input) + (///\in input) (..synthesize_let synthesize archive input @variable (#///analysis.Reference (///reference.local @output))))) (def: #export (synthesize_if synthesize archive test then else) @@ -253,7 +253,7 @@ (do ///.monad [then (synthesize archive then) else (synthesize archive else)] - (wrap (/.branch/if [test then else])))) + (in (/.branch/if [test then else])))) (template: (!get <patterns> <output>) [[(///analysis.pattern/tuple <patterns>) @@ -269,10 +269,10 @@ path (case input (^ (/.branch/get [sub_path sub_input])) - (///\wrap (/.branch/get [(list\compose path sub_path) sub_input])) + (///\in (/.branch/get [(list\compose path sub_path) sub_input])) _ - (///\wrap (/.branch/get [path input]))))) + (///\in (/.branch/get [path input]))))) (def: #export (synthesize synthesize^ [headB tailB+] archive inputA) (-> Phase Match Phase) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/function.lux index 2b0319266..10a5c6eec 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/function.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/function.lux @@ -59,49 +59,49 @@ (list.size argsS)) (do ! [locals /.locals] - (wrap (|> functionS - (//loop.optimization true locals argsS) - (maybe\map (: (-> [Nat (List Synthesis) Synthesis] Synthesis) - (function (_ [start inits iteration]) - (case iteration - (^ (/.loop/scope [start' inits' output])) - (if (and (n.= start start') - (list.empty? inits')) - (/.loop/scope [start inits output]) - (/.loop/scope [start inits iteration])) + (in (|> functionS + (//loop.optimization true locals argsS) + (maybe\map (: (-> [Nat (List Synthesis) Synthesis] Synthesis) + (function (_ [start inits iteration]) + (case iteration + (^ (/.loop/scope [start' inits' output])) + (if (and (n.= start start') + (list.empty? inits')) + (/.loop/scope [start inits output]) + (/.loop/scope [start inits iteration])) - _ - (/.loop/scope [start inits iteration]))))) - (maybe.default <apply>)))) - (wrap <apply>)) + _ + (/.loop/scope [start inits iteration]))))) + (maybe.default <apply>)))) + (in <apply>)) (^ (/.function/apply [funcS' argsS'])) - (wrap (/.function/apply [funcS' (list\compose argsS' argsS)])) + (in (/.function/apply [funcS' (list\compose argsS' argsS)])) _ - (wrap <apply>))))))) + (in <apply>))))))) (def: (find_foreign environment register) (-> (Environment Synthesis) Register (Operation Synthesis)) (case (list.nth register environment) (#.Some aliased) - (phase\wrap aliased) + (phase\in aliased) #.None - (phase.throw ..cannot_find_foreign_variable_in_environment [register environment]))) + (phase.except ..cannot_find_foreign_variable_in_environment [register environment]))) (def: (grow_path grow path) (-> (-> Synthesis (Operation Synthesis)) Path (Operation Path)) (case path (#/.Bind register) - (phase\wrap (#/.Bind (inc register))) + (phase\in (#/.Bind (inc register))) (^template [<tag>] [(<tag> left right) (do phase.monad [left' (grow_path grow left) right' (grow_path grow right)] - (wrap (<tag> left' right')))]) + (in (<tag> left' right')))]) ([#/.Alt] [#/.Seq]) (#/.Bit_Fork when then else) @@ -112,8 +112,8 @@ (\ ! map (|>> #.Some) (grow_path grow else)) #.None - (wrap #.None))] - (wrap (#/.Bit_Fork when then else))) + (in #.None))] + (in (#/.Bit_Fork when then else))) (^template [<tag>] [(<tag> [[test then] elses]) @@ -122,9 +122,9 @@ elses (monad.map ! (function (_ [else_test else_then]) (do ! [else_then (grow_path grow else_then)] - (wrap [else_test else_then]))) + (in [else_test else_then]))) elses)] - (wrap (<tag> [[test then] elses])))]) + (in (<tag> [[test then] elses])))]) ([#/.I64_Fork] [#/.F64_Fork] [#/.Text_Fork]) @@ -135,7 +135,7 @@ (phase\map (|>> #/.Then))) _ - (phase\wrap path))) + (phase\in path))) (def: (grow environment expression) (-> (Environment Synthesis) Synthesis (Operation Synthesis)) @@ -153,20 +153,20 @@ (phase\map (|>> /.tuple)))) (^ (..self_reference)) - (phase\wrap (/.function/apply [expression (list (/.variable/local 1))])) + (phase\in (/.function/apply [expression (list (/.variable/local 1))])) (#/.Reference reference) (case reference (#////reference.Variable variable) (case variable (#////reference/variable.Local register) - (phase\wrap (/.variable/local (inc register))) + (phase\in (/.variable/local (inc register))) (#////reference/variable.Foreign register) (..find_foreign environment register)) (#////reference.Constant constant) - (phase\wrap expression)) + (phase\in expression)) (#/.Control control) (case control @@ -176,25 +176,25 @@ (do phase.monad [inputS' (grow environment inputS) bodyS' (grow environment bodyS)] - (wrap (/.branch/let [inputS' (inc register) bodyS']))) + (in (/.branch/let [inputS' (inc register) bodyS']))) (#/.If [testS thenS elseS]) (do phase.monad [testS' (grow environment testS) thenS' (grow environment thenS) elseS' (grow environment elseS)] - (wrap (/.branch/if [testS' thenS' elseS']))) + (in (/.branch/if [testS' thenS' elseS']))) (#/.Get members inputS) (do phase.monad [inputS' (grow environment inputS)] - (wrap (/.branch/get [members inputS']))) + (in (/.branch/get [members inputS']))) (#/.Case [inputS pathS]) (do phase.monad [inputS' (grow environment inputS) pathS' (grow_path (grow environment) pathS)] - (wrap (/.branch/case [inputS' pathS'])))) + (in (/.branch/case [inputS' pathS'])))) (#/.Loop loop) (case loop @@ -202,7 +202,7 @@ (do {! phase.monad} [initsS+' (monad.map ! (grow environment) initsS+) iterationS' (grow environment iterationS)] - (wrap (/.loop/scope [(inc start) initsS+' iterationS']))) + (in (/.loop/scope [(inc start) initsS+' iterationS']))) (#/.Recur argumentsS+) (|> argumentsS+ @@ -220,20 +220,20 @@ captured (grow environment captured))) _env)] - (wrap (/.function/abstraction [_env' _arity _body]))) + (in (/.function/abstraction [_env' _arity _body]))) (#/.Apply funcS argsS+) (do {! phase.monad} [funcS (grow environment funcS) argsS+ (monad.map ! (grow environment) argsS+)] - (wrap (/.function/apply (case funcS - (^ (/.function/apply [(..self_reference) pre_argsS+])) - [(..self_reference) - (list\compose pre_argsS+ argsS+)] + (in (/.function/apply (case funcS + (^ (/.function/apply [(..self_reference) pre_argsS+])) + [(..self_reference) + (list\compose pre_argsS+ argsS+)] - _ - [funcS - argsS+])))))) + _ + [funcS + argsS+])))))) (#/.Extension name argumentsS+) (|> argumentsS+ @@ -241,7 +241,7 @@ (phase\map (|>> (#/.Extension name)))) (#/.Primitive _) - (phase\wrap expression))) + (phase\in expression))) (def: #export (abstraction phase environment archive bodyA) (-> Phase (Environment Analysis) Phase) @@ -262,16 +262,16 @@ #/.body body}))) _ - (wrap {#/.environment environment - #/.arity 1 - #/.body bodyS})))] - (wrap (if currying? - (/.function/abstraction abstraction) - (case (//loop.optimization false 1 (list) abstraction) - (#.Some [startL initsL bodyL]) - (/.function/abstraction {#/.environment environment - #/.arity (get@ #/.arity abstraction) - #/.body (/.loop/scope [startL initsL bodyL])}) - - #.None - (/.function/abstraction abstraction)))))) + (in {#/.environment environment + #/.arity 1 + #/.body bodyS})))] + (in (if currying? + (/.function/abstraction abstraction) + (case (//loop.optimization false 1 (list) abstraction) + (#.Some [startL initsL bodyL]) + (/.function/abstraction {#/.environment environment + #/.arity (get@ #/.arity abstraction) + #/.body (/.loop/scope [startL initsL bodyL])}) + + #.None + (/.function/abstraction abstraction)))))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/loop.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/loop.lux index ed5381e02..f64693134 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/loop.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/loop.lux @@ -37,7 +37,7 @@ (do maybe.monad [left' (recur left) right' (recur right)] - (wrap (<tag> left' right')))]) + (in (<tag> left' right')))]) ([#/.Alt] [#/.Seq]) (#/.Bit_Fork when then else) @@ -48,8 +48,8 @@ (\ ! map (|>> #.Some) (recur else)) #.None - (wrap #.None))] - (wrap (#/.Bit_Fork when then else))) + (in #.None))] + (in (#/.Bit_Fork when then else))) (^template [<tag>] [(<tag> [[test then] elses]) @@ -58,9 +58,9 @@ elses (monad.map ! (function (_ [else_test else_then]) (do ! [else_then (recur else_then)] - (wrap [else_test else_then]))) + (in [else_test else_then]))) elses)] - (wrap (<tag> [[test then] elses])))]) + (in (<tag> [[test then] elses])))]) ([#/.I64_Fork] [#/.F64_Fork] [#/.Text_Fork]) @@ -86,9 +86,9 @@ (#analysis.Variant variant) (do maybe.monad [value' (|> variant (get@ #analysis.value) (recur false))] - (wrap (|> variant - (set@ #analysis.value value') - /.variant))) + (in (|> variant + (set@ #analysis.value value') + /.variant))) (#analysis.Tuple tuple) (|> tuple @@ -117,25 +117,25 @@ (do maybe.monad [input' (recur false input) path' (path_optimization (recur return?) offset path)] - (wrap (|> path' [input'] /.branch/case))) + (in (|> path' [input'] /.branch/case))) (^ (/.branch/let [input register body])) (do maybe.monad [input' (recur false input) body' (recur return? body)] - (wrap (/.branch/let [input' (register_optimization offset register) body']))) + (in (/.branch/let [input' (register_optimization offset register) body']))) (^ (/.branch/if [input then else])) (do maybe.monad [input' (recur false input) then' (recur return? then) else' (recur return? else)] - (wrap (/.branch/if [input' then' else']))) + (in (/.branch/if [input' then' else']))) (^ (/.branch/get [path record])) (do maybe.monad [record (recur false record)] - (wrap (/.branch/get [path record]))) + (in (/.branch/get [path record]))) (^ (/.loop/scope scope)) (do {! maybe.monad} @@ -143,9 +143,9 @@ (get@ #/.inits) (monad.map ! (recur false))) iteration' (recur return? (get@ #/.iteration scope))] - (wrap (/.loop/scope {#/.start (|> scope (get@ #/.start) (register_optimization offset)) - #/.inits inits' - #/.iteration iteration'}))) + (in (/.loop/scope {#/.start (|> scope (get@ #/.start) (register_optimization offset)) + #/.inits inits' + #/.iteration iteration'}))) (^ (/.loop/recur args)) (|> args @@ -155,19 +155,19 @@ (^ (/.function/abstraction [environment arity body])) (do {! maybe.monad} [environment' (monad.map ! (recur false) environment)] - (wrap (/.function/abstraction [environment' arity body]))) + (in (/.function/abstraction [environment' arity body]))) (^ (/.function/apply [abstraction arguments])) (do {! maybe.monad} [arguments' (monad.map maybe.monad (recur false) arguments)] (with_expansions [<application> (as_is (do ! [abstraction' (recur false abstraction)] - (wrap (/.function/apply [abstraction' arguments']))))] + (in (/.function/apply [abstraction' arguments']))))] (case abstraction (^ (#/.Reference (#reference.Variable (variable.self)))) (if (and return? (n.= arity (list.size arguments))) - (wrap (/.loop/recur arguments')) + (in (/.loop/recur arguments')) (if true_loop? #.None <application>)) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/variable.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/variable.lux index 9e292c485..074790e37 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/variable.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/variable.lux @@ -205,8 +205,8 @@ (do try.monad [[redundancy head] (optimization [redundancy head]) [redundancy tail] (recur [redundancy tail])] - (wrap [redundancy - (#.Cons head tail)]))))) + (in [redundancy + (#.Cons head tail)]))))) (template [<name>] [(exception: #export (<name> {register Register}) @@ -224,13 +224,13 @@ (#try.Success (dictionary.put register ..redundant! redundancy)) (#.Some _) - (exception.throw ..redundant_declaration [register]))) + (exception.except ..redundant_declaration [register]))) (def: (observe register redundancy) (-> Register Redundancy (Try Redundancy)) (case (dictionary.get register redundancy) #.None - (exception.throw ..unknown_register [register]) + (exception.except ..unknown_register [register]) (#.Some _) (#try.Success (dictionary.put register ..necessary! redundancy)))) @@ -263,8 +263,8 @@ (recur [redundancy else])) #.None - (wrap [redundancy #.None]))] - (wrap [redundancy (#/.Bit_Fork when then else)])) + (in [redundancy #.None]))] + (in [redundancy (#/.Bit_Fork when then else)])) (^template [<tag> <type>] [(<tag> [[test then] elses]) @@ -274,9 +274,9 @@ (function (_ [redundancy [else_test else_then]]) (do ! [[redundancy else_then] (recur [redundancy else_then])] - (wrap [redundancy [else_test else_then]])))) + (in [redundancy [else_test else_then]])))) [redundancy elses])] - (wrap [redundancy (<tag> [[test then] elses])]))]) + (in [redundancy (<tag> [[test then] elses])]))]) ([#/.I64_Fork (I64 Any)] [#/.F64_Fork Frac] [#/.Text_Fork Text]) @@ -284,14 +284,14 @@ (#/.Bind register) (do try.monad [redundancy (..declare register redundancy)] - (wrap [redundancy - path])) + (in [redundancy + path])) (#/.Alt left right) (do try.monad [[redundancy left] (recur [redundancy left]) [redundancy right] (recur [redundancy right])] - (wrap [redundancy (#/.Alt left right)])) + (in [redundancy (#/.Alt left right)])) (#/.Seq pre post) (do try.monad @@ -310,15 +310,15 @@ (and (set.member? bindings register) redundant?))) (list\map product.left))]] - (wrap [(list\fold dictionary.remove redundancy (set.to_list bindings)) - (|> redundants - (list.sort n.>) - (list\fold (..remove_local_from_path ..remove_local) (#/.Seq pre post)))])) + (in [(list\fold dictionary.remove redundancy (set.to_list bindings)) + (|> redundants + (list.sort n.>) + (list\fold (..remove_local_from_path ..remove_local) (#/.Seq pre post)))])) (#/.Then then) (do try.monad [[redundancy then] (optimization [redundancy then])] - (wrap [redundancy (#/.Then then)])) + (in [redundancy (#/.Then then)])) ))) (def: (optimization' [redundancy synthesis]) @@ -334,14 +334,14 @@ (#analysis.Variant [lefts right value]) (do try.monad [[redundancy value] (optimization' [redundancy value])] - (wrap [redundancy - (#/.Structure (#analysis.Variant [lefts right value]))])) + (in [redundancy + (#/.Structure (#analysis.Variant [lefts right value]))])) (#analysis.Tuple tuple) (do try.monad [[redundancy tuple] (..list_optimization optimization' [redundancy tuple])] - (wrap [redundancy - (#/.Structure (#analysis.Tuple tuple))]))) + (in [redundancy + (#/.Structure (#analysis.Tuple tuple))]))) (#/.Reference reference) (case reference @@ -370,33 +370,33 @@ #let [redundant? (|> redundancy (dictionary.get register) (maybe.default ..necessary!))]] - (wrap [(dictionary.remove register redundancy) - (#/.Control (if redundant? - (#/.Branch (#/.Case input - (#/.Seq #/.Pop - (#/.Then (..remove_local register output))))) - (#/.Branch (#/.Let input register output))))])) + (in [(dictionary.remove register redundancy) + (#/.Control (if redundant? + (#/.Branch (#/.Case input + (#/.Seq #/.Pop + (#/.Then (..remove_local register output))))) + (#/.Branch (#/.Let input register output))))])) (#/.If test then else) (do try.monad [[redundancy test] (optimization' [redundancy test]) [redundancy then] (optimization' [redundancy then]) [redundancy else] (optimization' [redundancy else])] - (wrap [redundancy - (#/.Control (#/.Branch (#/.If test then else)))])) + (in [redundancy + (#/.Control (#/.Branch (#/.If test then else)))])) (#/.Get path record) (do try.monad [[redundancy record] (optimization' [redundancy record])] - (wrap [redundancy - (#/.Control (#/.Branch (#/.Get path record)))])) + (in [redundancy + (#/.Control (#/.Branch (#/.Get path record)))])) (#/.Case input path) (do try.monad [[redundancy input] (optimization' [redundancy input]) [redundancy path] (..path_optimization optimization' [redundancy path])] - (wrap [redundancy - (#/.Control (#/.Branch (#/.Case input path)))]))) + (in [redundancy + (#/.Control (#/.Branch (#/.Case input path)))]))) (#/.Loop loop) (case loop @@ -405,14 +405,14 @@ [[redundancy inits] (..list_optimization optimization' [redundancy inits]) #let [[extension redundancy] (..extended start (list.size inits) redundancy)] [redundancy iteration] (optimization' [redundancy iteration])] - (wrap [(list\fold dictionary.remove redundancy extension) - (#/.Control (#/.Loop (#/.Scope [start inits iteration])))])) + (in [(list\fold dictionary.remove redundancy extension) + (#/.Control (#/.Loop (#/.Scope [start inits iteration])))])) (#/.Recur resets) (do try.monad [[redundancy resets] (..list_optimization optimization' [redundancy resets])] - (wrap [redundancy - (#/.Control (#/.Loop (#/.Recur resets)))]))) + (in [redundancy + (#/.Control (#/.Loop (#/.Recur resets)))]))) (#/.Function function) (case function @@ -420,21 +420,21 @@ (do {! try.monad} [[redundancy environment] (..list_optimization optimization' [redundancy environment]) [_ body] (optimization' [(..default arity) body])] - (wrap [redundancy - (#/.Control (#/.Function (#/.Abstraction [environment arity body])))])) + (in [redundancy + (#/.Control (#/.Function (#/.Abstraction [environment arity body])))])) (#/.Apply abstraction inputs) (do try.monad [[redundancy abstraction] (optimization' [redundancy abstraction]) [redundancy inputs] (..list_optimization optimization' [redundancy inputs])] - (wrap [redundancy - (#/.Control (#/.Function (#/.Apply abstraction inputs)))])))) + (in [redundancy + (#/.Control (#/.Function (#/.Apply abstraction inputs)))])))) (#/.Extension name inputs) (do try.monad [[redundancy inputs] (..list_optimization optimization' [redundancy inputs])] - (wrap [redundancy - (#/.Extension name inputs)]))))) + (in [redundancy + (#/.Extension name inputs)]))))) (def: #export optimization (-> Synthesis (Try Synthesis)) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/program.lux b/stdlib/source/library/lux/tool/compiler/language/lux/program.lux index f33831904..3f988197f 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/program.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/program.lux @@ -42,16 +42,16 @@ (do ! [id (archive.id module archive) [descriptor document] (archive.find module archive)] - (wrap [[module id] (get@ #descriptor.registry descriptor)])))))] + (in [[module id] (get@ #descriptor.registry descriptor)])))))] (case (list.one (function (_ [[module module-id] registry]) (do maybe.monad [program-id (artifact.remember ..name registry)] - (wrap [module-id program-id]))) + (in [module-id program-id]))) registries) (#.Some program-context) - (wrap program-context) + (in program-context) #.None (|> registries (list\map (|>> product.left product.left)) - (exception.throw ..cannot-find-program))))) + (exception.except ..cannot-find-program))))) diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive.lux b/stdlib/source/library/lux/tool/compiler/meta/archive.lux index 4442bd5f3..a87745390 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive.lux @@ -95,15 +95,15 @@ (#try.Success id) #.None - (exception.throw ..unknown_document [module - (dictionary.keys resolver)])))) + (exception.except ..unknown_document [module + (dictionary.keys resolver)])))) (def: #export (reserve module archive) (-> Module Archive (Try [ID Archive])) (let [(^slots [#..next #..resolver]) (:representation archive)] (case (dictionary.get module resolver) (#.Some _) - (exception.throw ..module_has_already_been_reserved [module]) + (exception.except ..module_has_already_been_reserved [module]) #.None (#try.Success [next @@ -127,10 +127,10 @@ (if (is? document existing_document) ## TODO: Find out why this code allows for the same module to be added more than once. It looks fishy... (#try.Success archive) - (exception.throw ..cannot_replace_document [module existing_document document])) + (exception.except ..cannot_replace_document [module existing_document document])) #.None - (exception.throw ..module_must_be_reserved_before_it_can_be_added [module])))) + (exception.except ..module_must_be_reserved_before_it_can_be_added [module])))) (def: #export (find module archive) (-> Module Archive (Try [Descriptor (Document Any) Output])) @@ -140,11 +140,11 @@ (#try.Success entry) (#.Some [id #.None]) - (exception.throw ..module_is_only_reserved [module]) + (exception.except ..module_is_only_reserved [module]) #.None - (exception.throw ..unknown_document [module - (dictionary.keys resolver)])))) + (exception.except ..unknown_document [module + (dictionary.keys resolver)])))) (def: #export (archived? archive module) (-> Archive Module Bit) @@ -275,10 +275,10 @@ (n\= expected actual)) _ (exception.assert ..corrupt_data [] (correct_reservations? reservations))] - (wrap (:abstraction - {#next next - #resolver (list\fold (function (_ [module id] archive) - (dictionary.put module [id #.None] archive)) - (get@ #resolver (:representation ..empty)) - reservations)})))) + (in (:abstraction + {#next next + #resolver (list\fold (function (_ [module id] archive) + (dictionary.put module [id #.None] archive)) + (get@ #resolver (:representation ..empty)) + reservations)})))) ) diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive/descriptor.lux b/stdlib/source/library/lux/tool/compiler/meta/archive/descriptor.lux index 2c602ac89..08d1af30f 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive/descriptor.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive/descriptor.lux @@ -43,7 +43,7 @@ <b>.text <b>.text <b>.nat - (\ <>.monad wrap #.Cached) + (\ <>.monad in #.Cached) (<b>.set text.hash <b>.text) artifact.parser )) diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive/document.lux b/stdlib/source/library/lux/tool/compiler/meta/archive/document.lux index 3e2e86663..b8af027c1 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive/document.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive/document.lux @@ -41,8 +41,8 @@ e (:assume document//content))) - (exception.throw ..invalid_signature [(key.signature key) - document//signature])))) + (exception.except ..invalid_signature [(key.signature key) + document//signature])))) (def: #export (write key content) (All [d] (-> (Key d) d (Document d))) @@ -53,7 +53,7 @@ (All [d] (-> (Key d) (Document Any) (Try (Document d)))) (do try.monad [_ (..read key document)] - (wrap (:assume document)))) + (in (:assume document)))) (def: #export signature (-> (Document Any) Signature) diff --git a/stdlib/source/library/lux/tool/compiler/meta/cache/dependency.lux b/stdlib/source/library/lux/tool/compiler/meta/cache/dependency.lux index 3ba514b5f..37e5f7cfa 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/cache/dependency.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/cache/dependency.lux @@ -62,7 +62,7 @@ (#try.Failure error) ..fresh)] ancestors (monad.map ! recur (set.to_list parents))] - (wrap (list\fold set.union parents ancestors))))) + (in (list\fold set.union parents ancestors))))) ancestry (memo.open memo)] (list\fold (function (_ module memory) (if (dictionary.key? memory module) @@ -94,4 +94,4 @@ [module_id (archive.id module archive) [descriptor document output] (archive.find module archive) document (document.check key document)] - (wrap [module [module_id [descriptor document output]]]))))))) + (in [module [module_id [descriptor document output]]]))))))) diff --git a/stdlib/source/library/lux/tool/compiler/meta/io.lux b/stdlib/source/library/lux/tool/compiler/meta/io.lux index fe11727b7..8802d00bd 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/io.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/io.lux @@ -12,7 +12,7 @@ (type: #export Code Text) -(def: #export (sanitize system) +(def: #export (safe system) (All [m] (-> (System m) Text Text)) (text.replace_all "/" (\ system separator))) diff --git a/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux b/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux index ba2cec5c2..ee2e507e8 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux @@ -95,7 +95,7 @@ (do async.monad [? (\ fs directory? path)] (if ? - (wrap (#try.Success [])) + (in (#try.Success [])) (\ fs make_directory path)))) (def: #export (prepare fs static module_id) @@ -104,7 +104,7 @@ [#let [module (..module fs static module_id)] module_exists? (\ fs directory? module)] (if module_exists? - (wrap (#try.Success [])) + (in (#try.Success [])) (do (try.with !) [_ (ensure_directory fs (..unversioned_lux_archive fs static)) _ (ensure_directory fs (..versioned_lux_archive fs static))] @@ -114,9 +114,9 @@ (#try.Success []) (#try.Failure error) - (exception.throw ..cannot_prepare [(..archive fs static) - module_id - error]))))))))) + (exception.except ..cannot_prepare [(..archive fs static) + module_id + error]))))))))) (def: #export (write fs static module_id artifact_id content) (-> (file.System Async) Static archive.ID artifact.ID Binary (Async (Try Any))) @@ -172,9 +172,9 @@ (do ! [[descriptor document output] (archive.find module archive) content (document.read $.key document)] - (wrap [module content]))) + (in [module content]))) (archive.archived archive)))] - (wrap (set@ #.modules modules (fresh_analysis_state host))))) + (in (set@ #.modules modules (fresh_analysis_state host))))) (def: (cached_artifacts fs static module_id) (-> (file.System Async) Static archive.ID (Async (Try (Dictionary Text Binary)))) @@ -233,85 +233,85 @@ (do ! [#let [output (row.add [artifact_id #.None data] output)] _ (\ host re_learn context #.None directive)] - (wrap [definitions - [analysers - synthesizers - generators - directives] - output])) + (in [definitions + [analysers + synthesizers + generators + directives] + output])) (#artifact.Definition name) (let [output (row.add [artifact_id #.None data] output)] (if (text\= $/program.name name) - (wrap [definitions + (in [definitions + [analysers + synthesizers + generators + directives] + output]) + (do ! + [value (\ host re_load context #.None directive)] + (in [(dictionary.put name value definitions) [analysers synthesizers generators directives] - output]) - (do ! - [value (\ host re_load context #.None directive)] - (wrap [(dictionary.put name value definitions) - [analysers - synthesizers - generators - directives] - output])))) + output])))) (#artifact.Analyser extension) (do ! [#let [output (row.add [artifact_id #.None data] output)] value (\ host re_load context #.None directive)] - (wrap [definitions - [(dictionary.put extension (:as analysis.Handler value) analysers) - synthesizers - generators - directives] - output])) + (in [definitions + [(dictionary.put extension (:as analysis.Handler value) analysers) + synthesizers + generators + directives] + output])) (#artifact.Synthesizer extension) (do ! [#let [output (row.add [artifact_id #.None data] output)] value (\ host re_load context #.None directive)] - (wrap [definitions - [analysers - (dictionary.put extension (:as synthesis.Handler value) synthesizers) - generators - directives] - output])) + (in [definitions + [analysers + (dictionary.put extension (:as synthesis.Handler value) synthesizers) + generators + directives] + output])) (#artifact.Generator extension) (do ! [#let [output (row.add [artifact_id #.None data] output)] value (\ host re_load context #.None directive)] - (wrap [definitions - [analysers - synthesizers - (dictionary.put extension (:as generation.Handler value) generators) - directives] - output])) + (in [definitions + [analysers + synthesizers + (dictionary.put extension (:as generation.Handler value) generators) + directives] + output])) (#artifact.Directive extension) (do ! [#let [output (row.add [artifact_id #.None data] output)] value (\ host re_load context #.None directive)] - (wrap [definitions - [analysers - synthesizers - generators - (dictionary.put extension (:as directive.Handler value) directives)] - output])) + (in [definitions + [analysers + synthesizers + generators + (dictionary.put extension (:as directive.Handler value) directives)] + output])) (#artifact.Custom name) (do ! [#let [output (row.add [artifact_id (#.Some name) data] output)] _ (\ host re_learn context (#.Some name) directive)] - (wrap [definitions - [analysers - synthesizers - generators - directives] - output])))) + (in [definitions + [analysers + synthesizers + generators + directives] + output])))) (#try.Success [definitions' bundles' output']) (recur input' definitions' bundles' output') @@ -324,7 +324,7 @@ definitions (monad.map ! (function (_ [def_name def_global]) (case def_global (#.Alias alias) - (wrap [def_name (#.Alias alias)]) + (in [def_name (#.Alias alias)]) (#.Definition [exported? type annotations _]) (|> definitions @@ -334,8 +334,8 @@ #.Definition [def_name]))))) (get@ #.definitions content))] - (wrap [(document.write $.key (set@ #.definitions definitions content)) - bundles]))) + (in [(document.write $.key (set@ #.definitions definitions content)) + bundles]))) (def: (load_definitions fs static module_id host_environment descriptor document) (All [expression directive] @@ -346,8 +346,8 @@ (do (try.with async.monad) [actual (cached_artifacts fs static module_id) #let [expected (|> descriptor (get@ #descriptor.registry) artifact.artifacts)] - [document bundles output] (async\wrap (loaded_document (get@ #static.artifact_extension static) host_environment module_id expected actual document))] - (wrap [[descriptor document output] bundles]))) + [document bundles output] (async\in (loaded_document (get@ #static.artifact_extension static) host_environment module_id expected actual document))] + (in [[descriptor document output] bundles]))) (def: (purge! fs static [module_name module_id]) (-> (file.System Async) Static [Module archive.ID] (Async (Try Any))) @@ -412,14 +412,14 @@ (monad.map ! (function (_ [module_name module_id]) (do ! [data (..read_module_descriptor fs static module_id) - [descriptor document] (async\wrap (<binary>.run ..parser data))] + [descriptor document] (async\in (<binary>.run ..parser data))] (if (text\= archive.runtime_module module_name) - (wrap [true - [module_name [module_id [descriptor document]]]]) + (in [true + [module_name [module_id [descriptor document]]]]) (do ! [input (//context.read fs ..pseudo_module import contexts (get@ #static.host_module_extension static) module_name)] - (wrap [(..valid_cache? descriptor input) - [module_name [module_id [descriptor document]]]]))))))) + (in [(..valid_cache? descriptor input) + [module_name [module_id [descriptor document]]]]))))))) load_order (|> pre_loaded_caches (list\map product.right) (monad.fold try.monad @@ -428,7 +428,7 @@ archive) (\ try.monad map (dependency.load_order $.key)) (\ try.monad join) - async\wrap) + async\in) #let [purge (..full_purge pre_loaded_caches load_order)] _ (|> purge dictionary.entries @@ -438,9 +438,9 @@ (monad.map ! (function (_ [module_name [module_id [descriptor document _]]]) (do ! [[descriptor,document,output bundles] (..load_definitions fs static module_id host_environment descriptor document)] - (wrap [[module_name descriptor,document,output] - bundles])))))] - (async\wrap + (in [[module_name descriptor,document,output] + bundles])))))] + (async\in (do {! try.monad} [archive (monad.fold ! (function (_ [[module descriptor,document,output] _bundle] archive) @@ -448,16 +448,16 @@ archive loaded_caches) analysis_state (..analysis_state (get@ #static.host static) archive)] - (wrap [archive - analysis_state - (list\fold (function (_ [_ [+analysers +synthesizers +generators +directives]] - [analysers synthesizers generators directives]) - [(dictionary.merge +analysers analysers) - (dictionary.merge +synthesizers synthesizers) - (dictionary.merge +generators generators) - (dictionary.merge +directives directives)]) - ..empty_bundles - loaded_caches)]))))) + (in [archive + analysis_state + (list\fold (function (_ [_ [+analysers +synthesizers +generators +directives]] + [analysers synthesizers generators directives]) + [(dictionary.merge +analysers analysers) + (dictionary.merge +synthesizers synthesizers) + (dictionary.merge +generators generators) + (dictionary.merge +directives directives)]) + ..empty_bundles + loaded_caches)]))))) (def: #export (thaw host_environment fs static import contexts) (All [expression directive] @@ -468,10 +468,10 @@ (case binary (#try.Success binary) (do (try.with async.monad) - [archive (async\wrap (archive.import ///.version binary))] + [archive (async\in (archive.import ///.version binary))] (..load_every_reserved_module host_environment fs static import contexts archive)) (#try.Failure error) - (wrap (#try.Success [archive.empty - (fresh_analysis_state (get@ #static.host static)) - ..empty_bundles]))))) + (in (#try.Success [archive.empty + (fresh_analysis_state (get@ #static.host static)) + ..empty_bundles]))))) diff --git a/stdlib/source/library/lux/tool/compiler/meta/io/context.lux b/stdlib/source/library/lux/tool/compiler/meta/io/context.lux index f62d00cf2..b7838a270 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/io/context.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/io/context.lux @@ -56,14 +56,14 @@ (Async (Try file.Path))) (case contexts #.Nil - (async\wrap (exception.throw ..cannot_find_module [importer module])) + (async\in (exception.except ..cannot_find_module [importer module])) (#.Cons context contexts') (let [path (format (..path fs context module) extension)] (do async.monad [? (\ fs file? path)] (if ? - (wrap (#try.Success path)) + (in (#try.Success path)) (find_source_file fs importer contexts' module extension)))))) (def: (full_host_extension partial_host_extension) @@ -104,7 +104,7 @@ (#try.Success [path data]) #.None - (exception.throw ..cannot_find_module [importer module])))))) + (exception.except ..cannot_find_module [importer module])))))) (def: (find_any_source_file fs importer import contexts partial_host_extension module) (-> (file.System Async) Module Import (List Context) Extension Module @@ -115,10 +115,10 @@ [outcome (find_local_source_file fs importer import contexts partial_host_extension module)] (case outcome (#try.Success [path data]) - (wrap outcome) + (in outcome) (#try.Failure _) - (wrap (..find_library_source_file importer import partial_host_extension module))))) + (in (..find_library_source_file importer import partial_host_extension module))))) (def: #export (read fs importer import contexts partial_host_extension module) (-> (file.System Async) Module Import (List Context) Extension Module @@ -127,13 +127,13 @@ [[path binary] (..find_any_source_file fs importer import contexts partial_host_extension module)] (case (\ utf8.codec decode binary) (#try.Success code) - (wrap {#////.module module - #////.file path - #////.hash (text\hash code) - #////.code code}) + (in {#////.module module + #////.file path + #////.hash (text\hash code) + #////.code code}) (#try.Failure _) - (async\wrap (exception.throw ..cannot_read_module [module]))))) + (async\in (exception.except ..cannot_read_module [module]))))) (type: #export Enumeration (Dictionary file.Path Binary)) @@ -147,9 +147,8 @@ (if (text.ends_with? ..lux_extension file) (do ! [source_code (\ fs read file)] - (async\wrap - (dictionary.try_put (file.name fs file) source_code enumeration))) - (wrap enumeration))) + (async\in (dictionary.try_put (file.name fs file) source_code enumeration))) + (in enumeration))) enumeration)) (\ ! join))] (|> directory diff --git a/stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux b/stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux index 8f0b9ee68..6a25f1094 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux @@ -146,10 +146,10 @@ (text.suffix (get@ #static.artifact_extension static)))] (do try.monad [_ (java/util/jar/JarOutputStream::putNextEntry (java/util/jar/JarEntry::new class_path) sink)] - (wrap (do_to sink - (java/util/zip/ZipOutputStream::write content +0 (.int (binary.size content))) - (java/io/Flushable::flush) - (java/util/zip/ZipOutputStream::closeEntry)))))) + (in (do_to sink + (java/util/zip/ZipOutputStream::write content +0 (.int (binary.size content))) + (java/io/Flushable::flush) + (java/util/zip/ZipOutputStream::closeEntry)))))) (def: (write_module static [module output] sink) (-> Static [archive.ID Output] java/util/jar/JarOutputStream @@ -262,4 +262,4 @@ #let [_ (do_to sink (java/io/Flushable::flush) (java/io/Closeable::close))]] - (wrap (java/io/ByteArrayOutputStream::toByteArray buffer))))) + (in (java/io/ByteArrayOutputStream::toByteArray buffer))))) diff --git a/stdlib/source/library/lux/tool/compiler/meta/packager/scheme.lux b/stdlib/source/library/lux/tool/compiler/meta/packager/scheme.lux index e69755445..2239960c6 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/packager/scheme.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/packager/scheme.lux @@ -114,7 +114,7 @@ (\ encoding.utf8 encode) tar.content)) module_file (tar.path (..module_file module_id))] - (wrap (#tar.Normal [module_file now ..mode ..ownership entry_content])))) + (in (#tar.Normal [module_file now ..mode ..ownership entry_content])))) (def: #export (package now) (-> Instant Packager) @@ -127,6 +127,6 @@ (dictionary.of_list text.hash) (: (Dictionary Module archive.ID)))] entries (monad.map ! (..write_module now mapping) order)] - (wrap (|> entries - row.of_list - (binary.run tar.writer)))))) + (in (|> entries + row.of_list + (binary.run tar.writer)))))) diff --git a/stdlib/source/library/lux/tool/compiler/phase.lux b/stdlib/source/library/lux/tool/compiler/phase.lux index 522b564ab..845ba3dba 100644 --- a/stdlib/source/library/lux/tool/compiler/phase.lux +++ b/stdlib/source/library/lux/tool/compiler/phase.lux @@ -66,13 +66,13 @@ (function (_ state) (do try.monad [[state' output] (operation (get state))] - (wrap [(set state' state) output])))) + (in [(set state' state) output])))) (def: #export failure (-> Text Operation) (|>> #try.Failure (state.lift try.monad))) -(def: #export (throw exception parameters) +(def: #export (except exception parameters) (All [e] (-> (Exception e) e Operation)) (..failure (ex.construct exception parameters))) @@ -82,9 +82,9 @@ (try\map (|>> [state]) error))) (syntax: #export (assert exception message test) - (wrap (list (` (if (~ test) - (\ ..monad (~' wrap) []) - (..throw (~ exception) (~ message))))))) + (in (list (` (if (~ test) + (\ ..monad (~' in) []) + (..except (~ exception) (~ message))))))) (def: #export identity (All [s a] (Phase s a a)) @@ -100,13 +100,13 @@ (do try.monad [[pre/state' temp] (pre archive input pre/state) [post/state' output] (post archive temp post/state)] - (wrap [[pre/state' post/state'] output])))) + (in [[pre/state' post/state'] output])))) (def: #export (timed definition description operation) (All [s a] (-> Name Text (Operation s a) (Operation s a))) (do ..monad - [_ (wrap []) + [_ (in []) #let [pre (io.run instant.now)] output operation #let [_ (|> instant.now @@ -116,4 +116,4 @@ %.duration (format (%.name definition) " [" description "]: ") debug.log!)]] - (wrap output))) + (in output))) diff --git a/stdlib/source/library/lux/tool/interpreter.lux b/stdlib/source/library/lux/tool/interpreter.lux index 05daa46aa..ccd32f12a 100644 --- a/stdlib/source/library/lux/tool/interpreter.lux +++ b/stdlib/source/library/lux/tool/interpreter.lux @@ -85,7 +85,7 @@ [state _] (\ (get@ #platform.file_system platform) lift (phase.run' state enter_module)) _ (\ Console<!> write ..welcome_message)] - (wrap state))) + (in state))) (with_expansions [<Interpretation> (as_is (Operation anchor expression directive [Type Any]))] @@ -95,7 +95,7 @@ (do phase.monad [_ (total.phase code) _ init.refresh] - (wrap [Any []]))) + (in [Any []]))) (def: (interpret_expression code) (All [anchor expression directive] @@ -113,7 +113,7 @@ (analyse code)) codeT (type.with_env (check.clean codeT))] - (wrap [codeT codeA]))))) + (in [codeT codeA]))))) codeS (directive.lift_synthesis (synthesize codeA))] (directive.lift_generation @@ -122,7 +122,7 @@ [codeH (generate codeS) count generation.next codeV (generation.evaluate! (format "interpretation_" (%.nat count)) codeH)] - (wrap [codeT codeV])))))) + (in [codeT codeV])))))) (def: (interpret configuration code) (All [anchor expression directive] @@ -154,12 +154,12 @@ (do phase.monad [[codeT codeV] (interpret configuration code) state phase.get_state] - (wrap (/type.represent (get@ [#extension.state - #directive.analysis #directive.state - #extension.state] - state) - codeT - codeV)))) + (in (/type.represent (get@ [#extension.state + #directive.analysis #directive.state + #extension.state] + state) + codeT + codeV)))) (type: (Context anchor expression directive) {#configuration Configuration @@ -186,10 +186,10 @@ context} {(Operation anchor expression directive Text) (execute (get@ #configuration context) input)})))] - (wrap [(|> context - (set@ #state state') - (set@ #source source')) - representation])))) + (in [(|> context + (set@ #state state') + (set@ #source source')) + representation])))) (def: #export (run Monad<!> Console<!> platform configuration generation_bundle) (All [! anchor expression directive] diff --git a/stdlib/source/library/lux/type.lux b/stdlib/source/library/lux/type.lux index fbf41c94d..596272af0 100644 --- a/stdlib/source/library/lux/type.lux +++ b/stdlib/source/library/lux/type.lux @@ -382,7 +382,7 @@ (syntax: (new_secret_marker) (macro.with_gensyms [g!_secret_marker_] - (wrap (list g!_secret_marker_)))) + (in (list g!_secret_marker_)))) (def: secret_marker (`` (name_of (~~ (new_secret_marker))))) @@ -394,7 +394,7 @@ (#.Left [valueN valueC]) (do meta.monad [location meta.location - valueT (meta.find_type valueN) + valueT (meta.type valueN) #let [_ ("lux io log" ($_ text\compose (name\encode (name_of ..:log!)) " " (location.format location) text.new_line @@ -406,12 +406,12 @@ (name\encode valueN)) text.new_line " Type: " (..format valueT)))]] - (wrap (list (code.identifier valueN)))) + (in (list (code.identifier valueN)))) (#.Right valueC) (macro.with_gensyms [g!value] - (wrap (list (` (.let [(~ g!value) (~ valueC)] - (..:log! (~ valueC) (~ (code.identifier ..secret_marker)) (~ g!value))))))))) + (in (list (` (.let [(~ g!value) (~ valueC)] + (..:log! (~ valueC) (~ (code.identifier ..secret_marker)) (~ g!value))))))))) (def: type_parameters (Parser (List Text)) @@ -426,10 +426,10 @@ (|>> :assume)))] (case value #.None - (wrap (list casterC)) + (in (list casterC)) (#.Some value) - (wrap (list (` ((~ casterC) (~ value)))))))) + (in (list (` ((~ casterC) (~ value)))))))) (type: Typed {#type Code @@ -449,16 +449,16 @@ (~ (get@ #type computation)))) (.function ((~ g!_) (~ g!_)) (~ (get@ #expression computation)))))] - (wrap (list (` ((~ shareC) (~ (get@ #expression exemplar))))))))) + (in (list (` ((~ shareC) (~ (get@ #expression exemplar))))))))) (syntax: #export (:by_example {type_vars ..type_parameters} {exemplar ..typed} {extraction <code>.any}) - (wrap (list (` (:of ((~! :sharing) - [(~+ (list\map code.local_identifier type_vars))] - - (~ (get@ #type exemplar)) - (~ (get@ #expression exemplar)) - - (~ extraction) - (:assume []))))))) + (in (list (` (:of ((~! :sharing) + [(~+ (list\map code.local_identifier type_vars))] + + (~ (get@ #type exemplar)) + (~ (get@ #expression exemplar)) + + (~ extraction) + (:assume []))))))) diff --git a/stdlib/source/library/lux/type/abstract.lux b/stdlib/source/library/lux/type/abstract.lux index 0bd4a505a..a918db8e5 100644 --- a/stdlib/source/library/lux/type/abstract.lux +++ b/stdlib/source/library/lux/type/abstract.lux @@ -89,7 +89,7 @@ (#.Right [compiler frame]) #.None - (exception.throw ..no_active_frames []))))) + (exception.except ..no_active_frames []))))) (def: #export current (Meta Frame) @@ -172,14 +172,14 @@ (def: cast (Parser [(Maybe Text) Code]) (<>.either (<>.and (<>.maybe <code>.local_identifier) <code>.any) - (<>.and (<>\wrap #.None) <code>.any))) + (<>.and (<>\in #.None) <code>.any))) (template [<name> <from> <to>] [(syntax: #export (<name> {[frame value] ..cast}) (do meta.monad [[name type_vars abstraction representation] (peek! frame)] - (wrap (list (` ((~! :cast) [(~+ type_vars)] (~ <from>) (~ <to>) - (~ value)))))))] + (in (list (` ((~! :cast) [(~+ type_vars)] (~ <from>) (~ <to>) + (~ value)))))))] [:abstraction representation abstraction] [:representation abstraction representation] @@ -201,7 +201,7 @@ (def: declaration (Parser [Text (List Text)]) (<>.either (<code>.form (<>.and <code>.local_identifier (<>.some <code>.local_identifier))) - (<>.and <code>.local_identifier (\ <>.monad wrap (list))))) + (<>.and <code>.local_identifier (\ <>.monad in (list))))) ## TODO: Make sure the generated code always gets optimized away. ## (This applies to uses of ":abstraction" and ":representation") @@ -221,15 +221,15 @@ type_varsC abstraction_declaration representation_declaration])] - (wrap (list& (` (type: (~+ (|export|.format export)) (~ abstraction_declaration) - (~ (|annotations|.format annotations)) - (primitive (~ (code.text (abstraction_type_name [current_module name]))) - [(~+ type_varsC)]))) - (` (type: (~ representation_declaration) - (~ representation_type))) - ($_ list\compose - primitives - (list (` ((~! ..pop!))))))))) + (in (list& (` (type: (~+ (|export|.format export)) (~ abstraction_declaration) + (~ (|annotations|.format annotations)) + (primitive (~ (code.text (abstraction_type_name [current_module name]))) + [(~+ type_varsC)]))) + (` (type: (~ representation_declaration) + (~ representation_type))) + ($_ list\compose + primitives + (list (` ((~! ..pop!))))))))) (type: (Selection a) (#Specific Code a) @@ -243,12 +243,12 @@ (syntax: #export (:transmutation {selection (..selection <code>.any)}) (case selection (#Specific specific value) - (wrap (list (` (..:abstraction (~ specific) - (..:representation (~ specific) - (~ value)))))) + (in (list (` (..:abstraction (~ specific) + (..:representation (~ specific) + (~ value)))))) (#Current value) - (wrap (list (` (..:abstraction (..:representation (~ value)))))))) + (in (list (` (..:abstraction (..:representation (~ value)))))))) (syntax: #export (^:representation {selection (<code>.form (..selection <code>.local_identifier))} body @@ -256,14 +256,14 @@ (case selection (#Specific specific name) (let [g!var (code.local_identifier name)] - (wrap (list& g!var - (` (.let [(~ g!var) (..:representation (~ specific) (~ g!var))] - (~ body))) - branches))) + (in (list& g!var + (` (.let [(~ g!var) (..:representation (~ specific) (~ g!var))] + (~ body))) + branches))) (#Current name) (let [g!var (code.local_identifier name)] - (wrap (list& g!var - (` (.let [(~ g!var) (..:representation (~ g!var))] - (~ body))) - branches))))) + (in (list& g!var + (` (.let [(~ g!var) (..:representation (~ g!var))] + (~ body))) + branches))))) diff --git a/stdlib/source/library/lux/type/check.lux b/stdlib/source/library/lux/type/check.lux index f01edbe64..fc3b31347 100644 --- a/stdlib/source/library/lux/type/check.lux +++ b/stdlib/source/library/lux/type/check.lux @@ -1,4 +1,5 @@ -(.module: {#.doc "Type-checking functionality."} +(.module: + {#.doc "Type-checking functionality."} [library [lux #* ["@" target] @@ -104,7 +105,7 @@ (def: &functor ..functor) - (def: (wrap x) + (def: (in x) (function (_ context) (#try.Success [context x]))) @@ -177,7 +178,7 @@ (#try.Success [context []]) (#try.Failure message)))) -(def: #export (throw exception message) +(def: #export (except exception message) (All [e a] (-> (Exception e) e (Check a))) (..failure (exception.construct exception message))) @@ -202,7 +203,7 @@ (#try.Success [context <succeed>]) #.None - (exception.throw ..unknown_type_var id))))] + (exception.except ..unknown_type_var id))))] [bound? Bit false true] [read (Maybe Type) #.None (#.Some bound)] @@ -214,10 +215,10 @@ [?type (read id)] (case ?type (#.Some type) - (wrap type) + (in type) #.None - (..throw ..unbound_type_var id)))) + (..except ..unbound_type_var id)))) (def: (peek id) (-> Var (Check Type)) @@ -227,10 +228,10 @@ (#try.Success [context bound]) (#.Some _) - (exception.throw ..unbound_type_var id) + (exception.except ..unbound_type_var id) _ - (exception.throw ..unknown_type_var id)))) + (exception.except ..unknown_type_var id)))) (def: #export (bind type id) (-> Type Var (Check Any)) @@ -241,10 +242,10 @@ []]) (#.Some (#.Some bound)) - (exception.throw ..cannot_rebind_var [id type bound]) + (exception.except ..cannot_rebind_var [id type bound]) _ - (exception.throw ..unknown_type_var id)))) + (exception.except ..unknown_type_var id)))) (def: (update type id) (-> Type Var (Check Any)) @@ -255,7 +256,7 @@ []]) _ - (exception.throw ..unknown_type_var id)))) + (exception.except ..unknown_type_var id)))) (def: #export var (Check [Var Type]) @@ -277,7 +278,7 @@ (apply_type! funcT' argT) _ - (throw ..invalid_type_application [funcT argT]))) + (except ..invalid_type_application [funcT argT]))) (#.Apply argT' funcT') (do ..monad @@ -287,10 +288,10 @@ _ (case (//.applied (list argT) funcT) (#.Some output) - (check\wrap output) + (check\in output) _ - (throw ..invalid_type_application [funcT argT])))) + (except ..invalid_type_application [funcT argT])))) (type: Ring (Set Var)) @@ -320,7 +321,7 @@ (#try.Success [context output]) #.None - (exception.throw ..unknown_type_var current))))) + (exception.except ..unknown_type_var current))))) (def: #export fresh_context Type_Context @@ -395,7 +396,7 @@ (def: (check_vars check' assumptions idE idA) (-> (Checker Type) (Checker Var)) (if (!n\= idE idA) - (check\wrap assumptions) + (check\in assumptions) (do {! ..monad} [ebound (attempt (peek idE)) abound (attempt (peek idA))] @@ -404,7 +405,7 @@ [#.None #.None] (do ! [_ (link_2 idE idA)] - (wrap assumptions)) + (in assumptions)) ## Interpose new variable between 2 existing links [(#.Some etype) #.None] @@ -412,7 +413,7 @@ (#.Var targetE) (do ! [_ (link_3 idA targetE idE)] - (wrap assumptions)) + (in assumptions)) _ (check' assumptions etype (#.Var idA))) @@ -423,7 +424,7 @@ (#.Var targetA) (do ! [_ (link_3 idE targetA idA)] - (wrap assumptions)) + (in assumptions)) _ (check' assumptions (#.Var idE) atype)) @@ -435,23 +436,23 @@ [ringE (..ring idE) ringA (..ring idA)] (if (\ set.equivalence = ringE ringA) - (wrap assumptions) + (in assumptions) ## Fuse 2 rings (do ! [_ (monad.fold ! (function (_ interpose to) (do ! [_ (link_3 interpose to idE)] - (wrap interpose))) + (in interpose))) targetE (set.to_list ringA))] - (wrap assumptions)))) + (in assumptions)))) (^template [<pattern> <id> <type>] [<pattern> (do ! [ring (..ring <id>) _ (monad.map ! (update <type>) (set.to_list ring))] - (wrap assumptions))]) + (in assumptions))]) ([[(#.Var _) _] idE atype] [[_ (#.Var _)] idA etype]) @@ -559,7 +560,7 @@ (Checker Type) (if (for {@.php false} ## TODO: Remove this once JPHP is gone. (is? expected actual)) - (check\wrap assumptions) + (check\in assumptions) (with ..type_check_failed [expected actual] (case [expected actual] [(#.Var idE) (#.Var idA)] @@ -567,13 +568,13 @@ [(#.Var id) _] (if_bind id actual - (check\wrap assumptions) + (check\in assumptions) (function (_ bound) (check' assumptions bound actual))) [_ (#.Var id)] (if_bind id expected - (check\wrap assumptions) + (check\in assumptions) (function (_ bound) (check' assumptions expected bound))) @@ -588,7 +589,7 @@ [(#.Apply A F) _] (let [new_assumption [expected actual]] (if (assumed? new_assumption assumptions) - (check\wrap assumptions) + (check\in assumptions) (do ..monad [expected' (apply_type! F A)] (check' (assume! new_assumption assumptions) expected' actual)))) @@ -625,7 +626,7 @@ a_params a_params] (case [e_params a_params] [#.Nil #.Nil] - (check\wrap assumptions) + (check\in assumptions) [(#.Cons e_head e_tail) (#.Cons a_head a_tail)] (do ..monad @@ -651,7 +652,7 @@ [(#.Ex e!id) (#.Ex a!id)] (if (!n\= e!id a!id) - (check\wrap assumptions) + (check\in assumptions) ..silent_failure!) [(#.Named _ ?etype) _] @@ -692,7 +693,7 @@ (check\map (|>> (#.Primitive name)))) (^or (#.Parameter _) (#.Ex _) (#.Named _)) - (check\wrap inputT) + (check\in inputT) (^template [<tag>] [(<tag> leftT rightT) @@ -710,12 +711,12 @@ (clean actualT) _ - (wrap inputT))) + (in inputT))) (^template [<tag>] [(<tag> envT+ unquantifiedT) (do {! ..monad} [envT+' (monad.map ! clean envT+)] - (wrap (<tag> envT+' unquantifiedT)))]) + (in (<tag> envT+' unquantifiedT)))]) ([#.UnivQ] [#.ExQ]) )) diff --git a/stdlib/source/library/lux/type/dynamic.lux b/stdlib/source/library/lux/type/dynamic.lux index 5c5d79c81..f9a9d0c53 100644 --- a/stdlib/source/library/lux/type/dynamic.lux +++ b/stdlib/source/library/lux/type/dynamic.lux @@ -30,19 +30,19 @@ {#.doc (doc (: Dynamic (:dynamic 123)))} (with_gensyms [g!value] - (wrap (list (` (let [(~ g!value) (~ value)] - ((~! ..abstraction) [(:of (~ g!value)) (~ g!value)]))))))) + (in (list (` (let [(~ g!value) (~ value)] + ((~! ..abstraction) [(:of (~ g!value)) (~ g!value)]))))))) (syntax: #export (:check type value) {#.doc (doc (: (try.Try Nat) (:check Nat (:dynamic 123))))} (with_gensyms [g!type g!value] - (wrap (list (` (let [[(~ g!type) (~ g!value)] ((~! ..representation) (~ value))] - (: ((~! try.Try) (~ type)) - (if (\ (~! type.equivalence) (~' =) - (.type (~ type)) (~ g!type)) - (#try.Success (:as (~ type) (~ g!value))) - ((~! exception.throw) ..wrong_type [(.type (~ type)) (~ g!type)]))))))))) + (in (list (` (let [[(~ g!type) (~ g!value)] ((~! ..representation) (~ value))] + (: ((~! try.Try) (~ type)) + (if (\ (~! type.equivalence) (~' =) + (.type (~ type)) (~ g!type)) + (#try.Success (:as (~ type) (~ g!value))) + ((~! exception.except) ..wrong_type [(.type (~ type)) (~ g!type)]))))))))) (def: #export (format value) (-> Dynamic (Try Text)) diff --git a/stdlib/source/library/lux/type/implicit.lux b/stdlib/source/library/lux/type/implicit.lux index f405062e3..59b8288ed 100644 --- a/stdlib/source/library/lux/type/implicit.lux +++ b/stdlib/source/library/lux/type/implicit.lux @@ -27,17 +27,17 @@ ["." type ["." check (#+ Check)]]]]) -(def: (find_type_var id env) +(def: (type_var id env) (-> Nat Type_Context (Meta Type)) (case (list.find (|>> product.left (n.= id)) (get@ #.var_bindings env)) (#.Some [_ (#.Some type)]) (case type (#.Var id') - (find_type_var id' env) + (type_var id' env) _ - (\ meta.monad wrap type)) + (\ meta.monad in type)) (#.Some [_ #.None]) (meta.failure (format "Unbound type-var " (%.nat id))) @@ -49,20 +49,20 @@ (def: (resolve_type var_name) (-> Name (Meta Type)) (do meta.monad - [raw_type (meta.find_type var_name) + [raw_type (meta.type var_name) compiler meta.get_compiler] (case raw_type (#.Var id) - (find_type_var id (get@ #.type_context compiler)) + (type_var id (get@ #.type_context compiler)) _ - (wrap raw_type)))) + (in raw_type)))) -(def: (find_member_type idx sig_type) +(def: (member_type idx sig_type) (-> Nat Type (Check Type)) (case sig_type (#.Named _ sig_type') - (find_member_type idx sig_type') + (member_type idx sig_type') (#.Apply arg func) (case (type.applied (list arg) func) @@ -70,26 +70,26 @@ (check.failure (format "Cannot apply type " (%.type func) " to type " (%.type arg))) (#.Some sig_type') - (find_member_type idx sig_type')) + (member_type idx sig_type')) (#.Product left right) (if (n.= 0 idx) - (\ check.monad wrap left) - (find_member_type (dec idx) right)) + (\ check.monad in left) + (member_type (dec idx) right)) _ (if (n.= 0 idx) - (\ check.monad wrap sig_type) + (\ check.monad in sig_type) (check.failure (format "Cannot find member type " (%.nat idx) " for " (%.type sig_type)))))) -(def: (find_member_name member) +(def: (member_name member) (-> Name (Meta Name)) (case member ["" simple_name] (meta.either (do meta.monad [member (meta.normal member) _ (meta.resolve_tag member)] - (wrap member)) + (in member)) (do {! meta.monad} [this_module_name meta.current_module_name imp_mods (meta.imported_modules this_module_name) @@ -102,20 +102,20 @@ (meta.failure (format "Unknown tag: " (%.name member))) (#.Cons winner #.Nil) - (wrap winner) + (in winner) _ (meta.failure (format "Too many candidate tags: " (%.list %.name candidates)))))) _ - (\ meta.monad wrap member))) + (\ meta.monad in member))) (def: (resolve_member member) (-> Name (Meta [Nat Type])) (do meta.monad - [member (find_member_name member) + [member (member_name member) [idx tag_list sig_type] (meta.resolve_tag member)] - (wrap [idx sig_type]))) + (in [idx sig_type]))) (def: (prepare_definitions source_module target_module constants aggregate) (-> Text Text (List [Text Definition]) (-> (List [Name Type]) (List [Name Type]))) @@ -137,16 +137,16 @@ (: (Dictionary Text Type) (dictionary.new text.hash)) (list\join local_batches))]] - (wrap (|> total_locals - dictionary.entries - (list\map (function (_ [name type]) [["" name] type])))))) + (in (|> total_locals + dictionary.entries + (list\map (function (_ [name type]) [["" name] type])))))) (def: local_structs (Meta (List [Name Type])) (do {! meta.monad} [this_module_name meta.current_module_name definitions (meta.definitions this_module_name)] - (wrap (prepare_definitions this_module_name this_module_name definitions #.Nil)))) + (in (prepare_definitions this_module_name this_module_name definitions #.Nil)))) (def: imported_structs (Meta (List [Name Type])) @@ -154,10 +154,10 @@ [this_module_name meta.current_module_name imported_modules (meta.imported_modules this_module_name) accessible_definitions (monad.map ! meta.definitions imported_modules)] - (wrap (list\fold (function (_ [imported_module definitions] tail) - (prepare_definitions imported_module this_module_name definitions tail)) - #.Nil - (list.zipped/2 imported_modules accessible_definitions))))) + (in (list\fold (function (_ [imported_module definitions] tail) + (prepare_definitions imported_module this_module_name definitions tail)) + #.Nil + (list.zipped/2 imported_modules accessible_definitions))))) (def: (apply_function_type func arg) (-> Type Type (Check Type)) @@ -174,7 +174,7 @@ (#.Function input output) (do check.monad [_ (check.check input arg)] - (wrap output)) + (in output)) _ (check.failure (format "Invalid function type: " (%.type func))))) @@ -186,11 +186,11 @@ (do check.monad [[id var] check.var [ids final_output] (concrete_type (maybe.assume (type.applied (list var) type)))] - (wrap [(#.Cons id ids) - final_output])) + (in [(#.Cons id ids) + final_output])) _ - (\ check.monad wrap [(list) type]))) + (\ check.monad in [(list) type]))) (def: (check_apply member_type input_types output_type) (-> Type (List Type) Type (Check [])) @@ -221,7 +221,7 @@ _ (check.check dep alt_type) context' check.context =deps (monad.map ! (provision compiler context') deps)] - (wrap =deps))) + (in =deps))) (#.Left error) (list) @@ -232,7 +232,7 @@ (meta.failure (format "No candidates for provisioning: " (%.type dep))) found - (wrap found)))) + (in found)))) (def: (provision compiler context dep) (-> Lux Type_Context Type (Check Instance)) @@ -250,7 +250,7 @@ (check.failure (format "No candidates for provisioning: " (%.type dep))) (#.Cons winner #.Nil) - (\ check.monad wrap winner) + (\ check.monad in winner) _ (check.failure (format "Too many candidates for provisioning: " (%.type dep) " --- " (%.list (|>> product.left %.name) candidates)))) @@ -268,11 +268,11 @@ [[tvars alt_type] (concrete_type alt_type) #let [[deps alt_type] (type.flat_function alt_type)] _ (check.check alt_type sig_type) - member_type (find_member_type member_idx alt_type) + member_type (member_type member_idx alt_type) _ (check_apply member_type input_types output_type) context' check.context =deps (monad.map ! (provision compiler context') deps)] - (wrap =deps))) + (in =deps))) (#.Left error) (list) @@ -283,9 +283,9 @@ (meta.failure (format "No alternatives for " (%.type (type.function input_types output_type)))) found - (wrap found)))) + (in found)))) -(def: (find_alternatives sig_type member_idx input_types output_type) +(def: (alternatives sig_type member_idx input_types output_type) (-> Type Nat (List Type) Type (Meta (List Instance))) (let [test (test_alternatives sig_type member_idx input_types output_type)] ($_ meta.either @@ -348,15 +348,15 @@ [[member_idx sig_type] (resolve_member member) input_types (monad.map ! resolve_type args) output_type meta.expected_type - chosen_ones (find_alternatives sig_type member_idx input_types output_type)] + chosen_ones (alternatives sig_type member_idx input_types output_type)] (case chosen_ones #.Nil (meta.failure (format "No implementation could be found for member: " (%.name member))) (#.Cons chosen #.Nil) - (wrap (list (` (\ (~ (instance$ chosen)) - (~ (code.local_identifier (product.right member))) - (~+ (list\map code.identifier args)))))) + (in (list (` (\ (~ (instance$ chosen)) + (~ (code.local_identifier (product.right member))) + (~+ (list\map code.identifier args)))))) _ (meta.failure (format "Too many implementations available: " @@ -368,8 +368,8 @@ (#.Right [args _]) (do {! meta.monad} [labels (|> (macro.gensym "") (list.repeat (list.size args)) (monad.seq !))] - (wrap (list (` (let [(~+ (|> (list.zipped/2 labels args) (list\map join_pair) list\join))] - (..\\ (~ (code.identifier member)) (~+ labels))))))) + (in (list (` (let [(~+ (|> (list.zipped/2 labels args) (list\map join_pair) list\join))] + (..\\ (~ (code.identifier member)) (~+ labels))))))) )) (def: (implicit_bindings amount) @@ -385,17 +385,17 @@ (syntax: #export (with {implementations ..implicits} body) (do meta.monad [g!implicit+ (implicit_bindings (list.size implementations))] - (wrap (list (` (let [(~+ (|> (list.zipped/2 g!implicit+ implementations) - (list\map (function (_ [g!implicit implementation]) - (list g!implicit implementation))) - list\join))] - (~ body))))))) + (in (list (` (let [(~+ (|> (list.zipped/2 g!implicit+ implementations) + (list\map (function (_ [g!implicit implementation]) + (list g!implicit implementation))) + list\join))] + (~ body))))))) (syntax: #export (implicit: {implementations ..implicits}) (do meta.monad [g!implicit+ (implicit_bindings (list.size implementations))] - (wrap (|> (list.zipped/2 g!implicit+ implementations) - (list\map (function (_ [g!implicit implementation]) - (` (def: (~ g!implicit) - {#.implementation? #1} - (~ implementation))))))))) + (in (|> (list.zipped/2 g!implicit+ implementations) + (list\map (function (_ [g!implicit implementation]) + (` (def: (~ g!implicit) + {#.implementation? #1} + (~ implementation))))))))) diff --git a/stdlib/source/library/lux/type/quotient.lux b/stdlib/source/library/lux/type/quotient.lux index b872e6ff1..d4250a02f 100644 --- a/stdlib/source/library/lux/type/quotient.lux +++ b/stdlib/source/library/lux/type/quotient.lux @@ -41,13 +41,13 @@ (syntax: #export (type class) (with_gensyms [g!t g!c g!%] - (wrap (list (` ((~! type.:by_example) - [(~ g!t) (~ g!c) (~ g!%)] + (in (list (` ((~! type.:by_example) + [(~ g!t) (~ g!c) (~ g!%)] - (..Class (~ g!t) (~ g!c) (~ g!%)) - (~ class) - - (..Quotient (~ g!t) (~ g!c) (~ g!%)))))))) + (..Class (~ g!t) (~ g!c) (~ g!%)) + (~ class) + + (..Quotient (~ g!t) (~ g!c) (~ g!%)))))))) (implementation: #export (equivalence super) (All [t c %] (-> (Equivalence c) (Equivalence (..Quotient t c %)))) diff --git a/stdlib/source/library/lux/type/refinement.lux b/stdlib/source/library/lux/type/refinement.lux index 950a884ae..1b9d94381 100644 --- a/stdlib/source/library/lux/type/refinement.lux +++ b/stdlib/source/library/lux/type/refinement.lux @@ -82,8 +82,8 @@ (syntax: #export (type refiner) (macro.with_gensyms [g!t g!%] - (wrap (list (` ((~! type.:by_example) [(~ g!t) (~ g!%)] - (..Refiner (~ g!t) (~ g!%)) - (~ refiner) - - (..Refined (~ g!t) (~ g!%)))))))) + (in (list (` ((~! type.:by_example) [(~ g!t) (~ g!%)] + (..Refiner (~ g!t) (~ g!%)) + (~ refiner) + + (..Refined (~ g!t) (~ g!%)))))))) diff --git a/stdlib/source/library/lux/type/resource.lux b/stdlib/source/library/lux/type/resource.lux index 5fc4e760a..dc321578e 100644 --- a/stdlib/source/library/lux/type/resource.lux +++ b/stdlib/source/library/lux/type/resource.lux @@ -48,9 +48,9 @@ (implementation: (indexed Monad<m>) (All [m] (-> (Monad m) (IxMonad (Procedure m)))) - (def: (wrap value) + (def: (in value) (function (_ keys) - (\ Monad<m> wrap [keys value]))) + (\ Monad<m> in [keys value]))) (def: (bind f input) (function (_ keysI) @@ -67,14 +67,14 @@ (All [v] (-> (Linear <m> v) (<m> v))) (do <monad> [[_ output] (procedure [])] - (wrap output))) + (in output))) (def: #export (<lift> procedure) (All [v] (-> (<m> v) (Linear <m> v))) (function (_ keys) (do <monad> [output procedure] - (wrap [keys output]))))] + (in [keys output]))))] [pure Identity identity.monad run_pure lift_pure] [sync IO io.monad run_sync lift_sync] @@ -106,7 +106,7 @@ [(def: #export (<name> value) (All [v] (Ex [k] (-> v (Affine <m> (Key <mode> k) (Res k v))))) (function (_ keys) - (\ <monad> wrap [[(<key> []) keys] (:abstraction value)])))] + (\ <monad> in [[(<key> []) keys] (:abstraction value)])))] [ordered_pure Identity identity.monad Ordered ordered_key] [ordered_sync IO io.monad Ordered ordered_key] @@ -121,7 +121,7 @@ (All [v k m] (-> (Res k v) (Relevant <m> (Key m k) v))) (function (_ [key keys]) - (\ <monad> wrap [keys (:representation resource)])))] + (\ <monad> in [keys (:representation resource)])))] [read_pure Identity identity.monad] [read_sync IO io.monad] @@ -140,25 +140,25 @@ (do {! <>.monad} [done? <code>.end?] (if done? - (wrap (list)) + (in (list)) (do ! [head <code>.nat _ (<>.assert (exception.construct ..index_cannot_be_repeated head) (not (set.member? seen head))) tail (recur (set.add head seen))] - (wrap (list& head tail)))))))) + (in (list& head tail)))))))) (def: (no_op Monad<m>) (All [m] (-> (Monad m) (Linear m Any))) (function (_ context) - (\ Monad<m> wrap [context []]))) + (\ Monad<m> in [context []]))) (template [<name> <m> <monad>] [(syntax: #export (<name> {swaps ..indices}) (macro.with_gensyms [g!_ g!context] (case swaps #.Nil - (wrap (list (` ((~! no_op) <monad>)))) + (in (list (` ((~! no_op) <monad>)))) (#.Cons head tail) (do {! meta.monad} @@ -168,20 +168,20 @@ (function (_ from to) (do maybe.monad [input (list.nth from g!inputs)] - (wrap (row.add input to)))) + (in (row.add input to)))) (: (Row Code) row.empty) swaps) maybe.assume row.to_list) g!inputsT+ (list\map (|>> (~) (..Key ..Commutative) (`)) g!inputs) g!outputsT+ (list\map (|>> (~) (..Key ..Commutative) (`)) g!outputs)]] - (wrap (list (` (: (All [(~+ g!inputs) (~ g!context)] - (Procedure (~! <m>) - [(~+ g!inputsT+) (~ g!context)] - [(~+ g!outputsT+) (~ g!context)] - .Any)) - (function ((~ g!_) [(~+ g!inputs) (~ g!context)]) - (\ (~! <monad>) (~' wrap) [[(~+ g!outputs) (~ g!context)] []]))))))))))] + (in (list (` (: (All [(~+ g!inputs) (~ g!context)] + (Procedure (~! <m>) + [(~+ g!inputsT+) (~ g!context)] + [(~+ g!outputsT+) (~ g!context)] + .Any)) + (function ((~ g!_) [(~+ g!inputs) (~ g!context)]) + (\ (~! <monad>) (~' in) [[(~+ g!outputs) (~ g!context)] []]))))))))))] [exchange_pure Identity identity.monad] [exchange_sync IO io.monad] @@ -194,20 +194,20 @@ [raw <code>.nat _ (<>.assert (exception.construct ..amount_cannot_be_zero []) (n.> 0 raw))] - (wrap raw))) + (in raw))) (template [<name> <m> <monad> <from> <to>] [(syntax: #export (<name> {amount ..amount}) (macro.with_gensyms [g!_ g!context] (do {! meta.monad} [g!keys (<| (monad.seq !) (list.repeat amount) (macro.gensym "keys"))] - (wrap (list (` (: (All [(~+ g!keys) (~ g!context)] - (Procedure (~! <m>) - [<from> (~ g!context)] - [<to> (~ g!context)] - .Any)) - (function ((~ g!_) [<from> (~ g!context)]) - (\ (~! <monad>) (~' wrap) [[<to> (~ g!context)] []])))))))))] + (in (list (` (: (All [(~+ g!keys) (~ g!context)] + (Procedure (~! <m>) + [<from> (~ g!context)] + [<to> (~ g!context)] + .Any)) + (function ((~ g!_) [<from> (~ g!context)]) + (\ (~! <monad>) (~' in) [[<to> (~ g!context)] []])))))))))] [group_pure Identity identity.monad (~+ g!keys) [(~+ g!keys)]] [group_sync IO io.monad (~+ g!keys) [(~+ g!keys)]] diff --git a/stdlib/source/library/lux/type/unit.lux b/stdlib/source/library/lux/type/unit.lux index ccdb34d46..790aa77ad 100644 --- a/stdlib/source/library/lux/type/unit.lux +++ b/stdlib/source/library/lux/type/unit.lux @@ -91,16 +91,16 @@ (do meta.monad [@ meta.current_module_name #let [g!type (code.local_identifier type_name)]] - (wrap (list (` (type: (~+ (|export|.format export)) (~ g!type) - (~ (|annotations|.format annotations)) - (primitive (~ (code.text (%.name [@ type_name])))))) + (in (list (` (type: (~+ (|export|.format export)) (~ g!type) + (~ (|annotations|.format annotations)) + (primitive (~ (code.text (%.name [@ type_name])))))) - (` (implementation: (~+ (|export|.format export)) (~ (code.local_identifier unit_name)) - (..Unit (~ g!type)) + (` (implementation: (~+ (|export|.format export)) (~ (code.local_identifier unit_name)) + (..Unit (~ g!type)) - (def: (~' in) (~! ..in)) - (def: (~' out) (~! ..out)))) - )))) + (def: (~' in) (~! ..in)) + (def: (~' out) (~! ..out)))) + )))) (def: scale (Parser Ratio) @@ -111,7 +111,7 @@ denominator <code>.nat _ (<>.assert (format "Denominator must be positive: " (%.nat denominator)) (n.> 0 denominator))] - (wrap [numerator denominator])))) + (in [numerator denominator])))) (syntax: #export (scale: {export |export|.parser} @@ -122,26 +122,26 @@ (do meta.monad [@ meta.current_module_name #let [g!scale (code.local_identifier type_name)]] - (wrap (list (` (type: (~+ (|export|.format export)) ((~ g!scale) (~' u)) - (~ (|annotations|.format annotations)) - (primitive (~ (code.text (%.name [@ type_name]))) [(~' u)]))) - - (` (implementation: (~+ (|export|.format export)) (~ (code.local_identifier scale_name)) - (..Scale (~ g!scale)) - - (def: (~' scale) - (|>> ((~! ..out)) - (i.* (~ (code.int (.int numerator)))) - (i./ (~ (code.int (.int denominator)))) - ((~! ..in)))) - (def: (~' de_scale) - (|>> ((~! ..out)) - (i.* (~ (code.int (.int denominator)))) - (i./ (~ (code.int (.int numerator)))) - ((~! ..in)))) - (def: (~' ratio) - [(~ (code.nat numerator)) (~ (code.nat denominator))]))) - )))) + (in (list (` (type: (~+ (|export|.format export)) ((~ g!scale) (~' u)) + (~ (|annotations|.format annotations)) + (primitive (~ (code.text (%.name [@ type_name]))) [(~' u)]))) + + (` (implementation: (~+ (|export|.format export)) (~ (code.local_identifier scale_name)) + (..Scale (~ g!scale)) + + (def: (~' scale) + (|>> ((~! ..out)) + (i.* (~ (code.int (.int numerator)))) + (i./ (~ (code.int (.int denominator)))) + ((~! ..in)))) + (def: (~' de_scale) + (|>> ((~! ..out)) + (i.* (~ (code.int (.int denominator)))) + (i./ (~ (code.int (.int numerator)))) + ((~! ..in)))) + (def: (~' ratio) + [(~ (code.nat numerator)) (~ (code.nat denominator))]))) + )))) (def: #export (re_scale from to quantity) (All [si so u] (-> (Scale si) (Scale so) (Qty (si u)) (Qty (so u)))) diff --git a/stdlib/source/library/lux/world/console.lux b/stdlib/source/library/lux/world/console.lux index ee52d4029..e57fcd3e7 100644 --- a/stdlib/source/library/lux/world/console.lux +++ b/stdlib/source/library/lux/world/console.lux @@ -72,12 +72,12 @@ [?jvm_console (java/lang/System::console)] (case ?jvm_console #.None - (wrap (exception.throw ..cannot_open [])) + (in (exception.except ..cannot_open [])) (#.Some jvm_console) (let [jvm_input (java/lang/System::in) jvm_output (java/lang/System::out)] - (<| wrap + (<| in exception.return (: (Console IO)) ## TODO: Remove ASAP (implementation @@ -93,7 +93,7 @@ (java/io/PrintStream::print message jvm_output)) (def: close - (|>> (exception.throw ..cannot_close) wrap)))))))))] + (|>> (exception.except ..cannot_close) in)))))))))] (for {@.old (as_is <jvm>) @.jvm (as_is <jvm>)} (as_is))) @@ -124,10 +124,10 @@ (#try.Success [|state| output]) (do ! [_ (atom.write |state| state)] - (wrap (#try.Success output))) + (in (#try.Success output))) (#try.Failure error) - (wrap (#try.Failure error)))))] + (in (#try.Failure error)))))] [read on_read] [read_line on_read_line] @@ -140,10 +140,10 @@ (#try.Success |state|) (do ! [_ (atom.write |state| state)] - (wrap (#try.Success []))) + (in (#try.Success []))) (#try.Failure error) - (wrap (#try.Failure error))))) + (in (#try.Failure error))))) (def: (close _) (do {! io.monad} @@ -152,8 +152,8 @@ (#try.Success |state|) (do ! [_ (atom.write |state| state)] - (wrap (#try.Success []))) + (in (#try.Success []))) (#try.Failure error) - (wrap (#try.Failure error))))) + (in (#try.Failure error))))) )))) diff --git a/stdlib/source/library/lux/world/db/jdbc.lux b/stdlib/source/library/lux/world/db/jdbc.lux index 4fed0df0e..ccc9d91af 100644 --- a/stdlib/source/library/lux/world/db/jdbc.lux +++ b/stdlib/source/library/lux/world/db/jdbc.lux @@ -98,7 +98,7 @@ _ (io.io ((get@ #input statement) (get@ #value statement) [1 prepared])) result (action prepared) _ (java/sql/Statement::close prepared)] - (wrap result))) + (in result))) (def: #export (async db) (-> (DB IO) (DB Async)) @@ -117,41 +117,41 @@ [connection (java/sql/DriverManager::getConnection (get@ #url creds) (get@ #user creds) (get@ #password creds))] - (wrap (: (DB IO) - (implementation - (def: execute - (..can-execute - (function (execute statement) - (with-statement statement connection - (function (_ prepared) - (do (try.with io.monad) - [row-count (java/sql/PreparedStatement::executeUpdate prepared)] - (wrap (.nat row-count)))))))) - - (def: insert - (..can-insert - (function (insert statement) - (with-statement statement connection - (function (_ prepared) - (do (try.with io.monad) - [_ (java/sql/PreparedStatement::executeUpdate prepared) - result-set (io.io (java/sql/Statement::getGeneratedKeys prepared))] - (/output.rows /output.long result-set))))))) - - (def: close - (..can-close - (function (close _) - (java/sql/Connection::close connection)))) - - (def: query - (..can-query - (function (query [statement output]) - (with-statement statement connection - (function (_ prepared) - (do (try.with io.monad) - [result-set (java/sql/PreparedStatement::executeQuery prepared)] - (/output.rows output result-set))))))) - ))))) + (in (: (DB IO) + (implementation + (def: execute + (..can-execute + (function (execute statement) + (with-statement statement connection + (function (_ prepared) + (do (try.with io.monad) + [row-count (java/sql/PreparedStatement::executeUpdate prepared)] + (in (.nat row-count)))))))) + + (def: insert + (..can-insert + (function (insert statement) + (with-statement statement connection + (function (_ prepared) + (do (try.with io.monad) + [_ (java/sql/PreparedStatement::executeUpdate prepared) + result-set (io.io (java/sql/Statement::getGeneratedKeys prepared))] + (/output.rows /output.long result-set))))))) + + (def: close + (..can-close + (function (close _) + (java/sql/Connection::close connection)))) + + (def: query + (..can-query + (function (query [statement output]) + (with-statement statement connection + (function (_ prepared) + (do (try.with io.monad) + [result-set (java/sql/PreparedStatement::executeQuery prepared)] + (/output.rows output result-set))))))) + ))))) (def: #export (with-db creds action) (All [a] @@ -162,7 +162,7 @@ [db (..connect creds) result (action db) _ (!.use (\ db close) [])] - (wrap result))) + (in result))) (def: #export (with-async-db creds action) (All [a] @@ -172,5 +172,5 @@ (do (try.with async.monad) [db (async.future (..connect creds)) result (action (..async db)) - _ (async\wrap (io.run (!.use (\ db close) [])))] - (wrap result))) + _ (async\in (io.run (!.use (\ db close) [])))] + (in result))) diff --git a/stdlib/source/library/lux/world/db/jdbc/input.lux b/stdlib/source/library/lux/world/db/jdbc/input.lux index 9c3de1238..7388e1334 100644 --- a/stdlib/source/library/lux/world/db/jdbc/input.lux +++ b/stdlib/source/library/lux/world/db/jdbc/input.lux @@ -75,7 +75,7 @@ (function (_ value [idx statement]) (do try.monad [_ (<setter> (.int idx) value statement)] - (wrap [(.inc idx) statement]))))] + (in [(.inc idx) statement]))))] [boolean Bit java/sql/PreparedStatement::setBoolean] @@ -99,7 +99,7 @@ [_ (<setter> (.int idx) (<constructor> (instant.to-millis value)) statement)] - (wrap [(.inc idx) statement]))))] + (in [(.inc idx) statement]))))] [date java/sql/PreparedStatement::setDate java/sql/Date::new] [time java/sql/PreparedStatement::setTime java/sql/Time::new] diff --git a/stdlib/source/library/lux/world/db/jdbc/output.lux b/stdlib/source/library/lux/world/db/jdbc/output.lux index e6aae5c1e..4ddc8ea2d 100644 --- a/stdlib/source/library/lux/world/db/jdbc/output.lux +++ b/stdlib/source/library/lux/world/db/jdbc/output.lux @@ -86,7 +86,7 @@ (def: &functor ..functor) - (def: (wrap a) + (def: (in a) (function (_ [idx rs]) (#.Some [idx a]))) @@ -110,7 +110,7 @@ (do ..monad [=left left =right right] - (wrap [=left =right]))) + (in [=left =right]))) (template [<func-name> <method-name> <type>] [(def: #export <func-name> @@ -165,31 +165,31 @@ [?tail (rows output results)] (case ?tail (#try.Success tail) - (wrap (ex.return (#.Cons head tail))) + (in (ex.return (#.Cons head tail))) (#try.Failure error) (do io.monad [temp (java/sql/ResultSet::close results)] - (wrap (do try.monad - [_ temp] - (try.failure error)))))) + (in (do try.monad + [_ temp] + (try.failure error)))))) (#try.Failure error) (do io.monad [temp (java/sql/ResultSet::close results)] - (wrap (do try.monad - [_ temp] - (try.failure error))))) + (in (do try.monad + [_ temp] + (try.failure error))))) (do io.monad [temp (java/sql/ResultSet::close results)] - (wrap (do try.monad - [_ temp] - (wrap (list)))))) + (in (do try.monad + [_ temp] + (in (list)))))) (#try.Failure error) (do io.monad [temp (java/sql/ResultSet::close results)] - (wrap (do try.monad - [_ temp] - (try.failure error)))) + (in (do try.monad + [_ temp] + (try.failure error)))) )) diff --git a/stdlib/source/library/lux/world/file.lux b/stdlib/source/library/lux/world/file.lux index d34904eea..f66458f87 100644 --- a/stdlib/source/library/lux/world/file.lux +++ b/stdlib/source/library/lux/world/file.lux @@ -87,7 +87,7 @@ (do maybe.monad [[parent temp] (text.split last_separator path) [_ child] (text.split (text.size /) temp)] - (wrap [parent child]))))) + (in [parent child]))))) (def: #export (parent fs path) (All [!] (-> (System !) Path (Maybe Path))) @@ -234,7 +234,7 @@ (\ ! join)) #.None - (\ io.monad wrap (exception.throw ..cannot_find_directory [path])))))] + (\ io.monad in (exception.except ..cannot_find_directory [path])))))] [directory_files java/io/File::isFile] [sub_directories java/io/File::isDirectory] @@ -263,8 +263,8 @@ bytes_read (java/io/InputStream::read data stream) _ (java/lang/AutoCloseable::close stream)] (if (i.= size bytes_read) - (wrap data) - (\ io.monad wrap (exception.throw ..cannot_read_all_data path))))) + (in data) + (\ io.monad in (exception.except ..cannot_read_all_data path))))) (def: (delete path) (|> path @@ -413,12 +413,12 @@ [?stats (with_async write! (Try Stats) (Fs::stat [path (..value_callback write!)] (..node_fs [])))] - (wrap (case ?stats - (#try.Success stats) - (<method> [] stats) - - (#try.Failure _) - false))))] + (in (case ?stats + (#try.Success stats) + (<method> [] stats) + + (#try.Failure _) + false))))] [file? Stats::isFile] [directory? Stats::isDirectory] @@ -434,7 +434,7 @@ node_fs))] (case outcome (#try.Success _) - (wrap (exception.throw ..cannot_make_directory [path])) + (in (exception.except ..cannot_make_directory [path])) (#try.Failure _) (with_async write! (Try Any) @@ -465,20 +465,20 @@ [stats (with_async write! (Try Stats) (Fs::stat [path (..value_callback write!)] (..node_fs [])))] - (wrap (|> stats - Stats::size - f.nat)))) + (in (|> stats + Stats::size + f.nat)))) (def: (last_modified path) (do (try.with async.monad) [stats (with_async write! (Try Stats) (Fs::stat [path (..value_callback write!)] (..node_fs [])))] - (wrap (|> stats - Stats::mtimeMs - f.int - duration.of_millis - instant.absolute)))) + (in (|> stats + Stats::mtimeMs + f.int + duration.of_millis + instant.absolute)))) (def: (can_execute? path) (let [node_fs (..node_fs [])] @@ -625,7 +625,7 @@ [file (..open [path "rb"]) data (PyFile::read [] file) _ (PyFile::close [] file)] - (wrap data))) + (in data))) (def: (delete path) (do (try.with io.monad) @@ -727,7 +727,7 @@ (list))] (case input #.Nil - (wrap output) + (in output) (#.Cons head tail) (do ! @@ -736,7 +736,7 @@ (#.Cons head output) output))))) _ (RubyDir::close [] self)] - (wrap output)))] + (in output)))] [directory_files RubyFile::file?] [sub_directories RubyFile::directory?] @@ -763,7 +763,7 @@ [file (RubyFile::open [path "rb"]) data (RubyFile::read [] file) _ (RubyFile::close [] file)] - (wrap data))) + (in data))) (def: (delete path) (do (try.with io.monad) @@ -788,7 +788,7 @@ data (RubyFile::write [data] file) _ (RubyFile::flush [] file) _ (RubyFile::close [] file)] - (wrap [])))] + (in [])))] ["wb" write] ["ab" append] @@ -797,7 +797,7 @@ (def: (move destination origin) (do (try.with io.monad) [_ (RubyFileUtils::move [origin destination])] - (wrap []))) + (in []))) ))) ## @.php @@ -849,8 +849,8 @@ ## (do {! (try.with io.monad)} ## [outcome (..file_put_contents [path ("php pack" ..byte_array_format data) <mode>])] ## (if (bit\= false (:as Bit outcome)) - ## (\ io.monad wrap (exception.throw ..cannot_write_to_file [path])) - ## (wrap []))))] + ## (\ io.monad in (exception.except ..cannot_write_to_file [path])) + ## (in []))))] ## [over_write +0] ## [append (..FILE_APPEND)] @@ -860,8 +860,8 @@ ## (do {! (try.with io.monad)} ## [data (..file_get_contents [path])] ## (if (bit\= false (:as Bit data)) - ## (\ io.monad wrap (exception.throw ..cannot_find_file [path])) - ## (wrap (..unpack [..byte_array_format data]))))) + ## (\ io.monad in (exception.except ..cannot_find_file [path])) + ## (in (..unpack [..byte_array_format data]))))) ## (def: path ## path) @@ -871,8 +871,8 @@ ## (do {! (try.with io.monad)} ## [value (<ffi> [path])] ## (if (bit\= false (:as Bit value)) - ## (\ io.monad wrap (exception.throw ..cannot_find_file [path])) - ## (wrap (`` (|> value (~~ (template.spliced <pipeline>))))))))] + ## (\ io.monad in (exception.except ..cannot_find_file [path])) + ## (in (`` (|> value (~~ (template.spliced <pipeline>))))))))] ## [size ..filesize [.nat]] ## [last_modified ..filemtime [(i.* +1,000) duration.of_millis instant.absolute]] @@ -885,22 +885,22 @@ ## (do {! (try.with io.monad)} ## [verdict (..touch [path (|> moment instant.relative duration.to_millis (i./ +1,000))])] ## (if (bit\= false (:as Bit verdict)) - ## (\ io.monad wrap (exception.throw ..cannot_find_file [path])) - ## (wrap [])))) + ## (\ io.monad in (exception.except ..cannot_find_file [path])) + ## (in [])))) ## (def: (move destination) ## (do {! (try.with io.monad)} ## [verdict (..rename [path destination])] ## (if (bit\= false (:as Bit verdict)) - ## (\ io.monad wrap (exception.throw ..cannot_find_file [path])) - ## (wrap (file destination))))) + ## (\ io.monad in (exception.except ..cannot_find_file [path])) + ## (in (file destination))))) ## (def: (delete _) ## (do (try.with io.monad) ## [verdict (..unlink [path])] ## (if (bit\= false (:as Bit verdict)) - ## (\ io.monad wrap (exception.throw ..cannot_find_file [path])) - ## (wrap [])))) + ## (\ io.monad in (exception.except ..cannot_find_file [path])) + ## (in [])))) ## )) ## (`` (implementation: (directory path) @@ -922,7 +922,7 @@ ## (list))] ## (case input ## #.Nil - ## (wrap output) + ## (in output) ## (#.Cons head tail) ## (do ! @@ -939,8 +939,8 @@ ## (do (try.with io.monad) ## [verdict (..rmdir [path])] ## (if (bit\= false (:as Bit verdict)) - ## (\ io.monad wrap (exception.throw ..cannot_find_directory [path])) - ## (wrap [])))) + ## (\ io.monad in (exception.except ..cannot_find_directory [path])) + ## (in [])))) ## )) ## (`` (implementation: #export default @@ -950,10 +950,10 @@ ## [(def: (<name> path) ## (do {! (try.with io.monad)} ## [verdict (<test> path)] - ## (\ io.monad wrap + ## (\ io.monad in ## (if verdict ## (#try.Success (<constructor> path)) - ## (exception.throw <exception> [path])))))] + ## (exception.except <exception> [path])))))] ## [file ..is_file ..file ..cannot_find_file] ## [directory ..is_dir ..directory ..cannot_find_directory] @@ -962,18 +962,18 @@ ## (def: (make_file path) ## (do {! (try.with io.monad)} ## [verdict (..touch [path (|> instant.now io.run instant.relative duration.to_millis (i./ +1,000))])] - ## (\ io.monad wrap + ## (\ io.monad in ## (if verdict ## (#try.Success (..file path)) - ## (exception.throw ..cannot_make_file [path]))))) + ## (exception.except ..cannot_make_file [path]))))) ## (def: (make_directory path) ## (do {! (try.with io.monad)} ## [verdict (..mkdir path)] - ## (\ io.monad wrap + ## (\ io.monad in ## (if verdict ## (#try.Success (..directory path)) - ## (exception.throw ..cannot_make_directory [path]))))) + ## (exception.except ..cannot_make_directory [path]))))) ## (def: separator ## ..default_separator) @@ -987,7 +987,7 @@ (do monad [verdict (\ fs file? path)] (if verdict - (wrap verdict) + (in verdict) (\ fs directory? path)))) (type: Mock_File @@ -1010,7 +1010,7 @@ (#.Cons head tail) (case (dictionary.get head directory) #.None - (exception.throw ..cannot_find_file [path]) + (exception.except ..cannot_find_file [path]) (#.Some node) (case [node tail] @@ -1021,10 +1021,10 @@ (recur sub_directory tail) _ - (exception.throw ..cannot_find_file [path]))) + (exception.except ..cannot_find_file [path]))) #.Nil - (exception.throw ..cannot_find_file [path])))) + (exception.except ..cannot_find_file [path])))) (def: (update_mock_file! / path now content mock) (-> Text Path Instant Binary Mock (Try Mock)) @@ -1043,7 +1043,7 @@ directory)) (#.Cons _) - (exception.throw ..cannot_find_file [path])) + (exception.except ..cannot_find_file [path])) (#.Some node) (case [node tail] @@ -1057,13 +1057,13 @@ [(#.Right sub_directory) (#.Cons _)] (do try.monad [sub_directory (recur sub_directory tail)] - (wrap (dictionary.put head (#.Right sub_directory) directory))) + (in (dictionary.put head (#.Right sub_directory) directory))) _ - (exception.throw ..cannot_find_file [path]))) + (exception.except ..cannot_find_file [path]))) #.Nil - (exception.throw ..cannot_find_file [path])))) + (exception.except ..cannot_find_file [path])))) (def: (mock_delete! / path mock) (-> Text Path Mock (Try Mock)) @@ -1073,7 +1073,7 @@ (#.Cons head tail) (case (dictionary.get head directory) #.None - (exception.throw ..cannot_delete [path]) + (exception.except ..cannot_delete [path]) (#.Some node) (case tail @@ -1085,20 +1085,20 @@ (#.Right sub_directory) (if (dictionary.empty? sub_directory) (#try.Success (dictionary.remove head directory)) - (exception.throw ..cannot_delete [path]))) + (exception.except ..cannot_delete [path]))) (#.Cons _) (case node (#.Left file) - (exception.throw ..cannot_delete [path]) + (exception.except ..cannot_delete [path]) (#.Right sub_directory) (do try.monad [sub_directory' (recur sub_directory tail)] - (wrap (dictionary.put head (#.Right sub_directory') directory)))))) + (in (dictionary.put head (#.Right sub_directory') directory)))))) #.Nil - (exception.throw ..cannot_delete [path])))) + (exception.except ..cannot_delete [path])))) (def: (try_update! transform var) (All [a] (-> (-> a (Try a)) (Var a) (STM (Try Any)))) @@ -1108,10 +1108,10 @@ (#try.Success |var|) (do ! [_ (stm.write |var| var)] - (wrap (#try.Success []))) + (in (#try.Success []))) (#try.Failure error) - (wrap (#try.Failure error))))) + (in (#try.Failure error))))) (def: (make_mock_directory! / path mock) (-> Text Path Mock (Try Mock)) @@ -1126,20 +1126,20 @@ (#try.Success (dictionary.put head (#.Right ..empty_mock) directory)) (#.Cons _) - (exception.throw ..cannot_make_directory [path])) + (exception.except ..cannot_make_directory [path])) (#.Some node) (case [node tail] [(#.Right sub_directory) (#.Cons _)] (do try.monad [sub_directory (recur sub_directory tail)] - (wrap (dictionary.put head (#.Right sub_directory) directory))) + (in (dictionary.put head (#.Right sub_directory) directory))) _ - (exception.throw ..cannot_make_directory [path]))) + (exception.except ..cannot_make_directory [path]))) #.Nil - (exception.throw ..cannot_make_directory [path])))) + (exception.except ..cannot_make_directory [path])))) (def: (retrieve_mock_directory! / path mock) (-> Text Path Mock (Try Mock)) @@ -1152,12 +1152,12 @@ (#.Cons head tail) (case (dictionary.get head directory) #.None - (exception.throw ..cannot_find_directory [path]) + (exception.except ..cannot_find_directory [path]) (#.Some node) (case node (#.Left _) - (exception.throw ..cannot_find_directory [path]) + (exception.except ..cannot_find_directory [path]) (#.Right sub_directory) (case tail @@ -1195,27 +1195,27 @@ (#try.Success |store|) (do ! [_ (stm.write |store| store)] - (wrap (#try.Success []))) + (in (#try.Success []))) (#try.Failure error) - (wrap (#try.Failure error)))))) + (in (#try.Failure error)))))) (~~ (template [<method> <tag>] [(def: (<method> path) (stm.commit (do stm.monad [|store| (stm.read store)] - (wrap (do try.monad - [directory (..retrieve_mock_directory! separator path |store|)] - (wrap (|> directory - dictionary.entries - (list.all (function (_ [node_name node]) - (case node - (<tag> _) - (#.Some (format path separator node_name)) - - _ - #.None))))))))))] + (in (do try.monad + [directory (..retrieve_mock_directory! separator path |store|)] + (in (|> directory + dictionary.entries + (list.all (function (_ [node_name node]) + (case node + (<tag> _) + (#.Some (format path separator node_name)) + + _ + #.None))))))))))] [directory_files #.Left] [sub_directories #.Right] @@ -1225,38 +1225,38 @@ (stm.commit (do stm.monad [|store| (stm.read store)] - (wrap (|> |store| - (..retrieve_mock_file! separator path) - (try\map (|>> product.right - (get@ #mock_content) - binary.size))))))) + (in (|> |store| + (..retrieve_mock_file! separator path) + (try\map (|>> product.right + (get@ #mock_content) + binary.size))))))) (def: (last_modified path) (stm.commit (do stm.monad [|store| (stm.read store)] - (wrap (|> |store| - (..retrieve_mock_file! separator path) - (try\map (|>> product.right - (get@ #mock_last_modified)))))))) + (in (|> |store| + (..retrieve_mock_file! separator path) + (try\map (|>> product.right + (get@ #mock_last_modified)))))))) (def: (can_execute? path) (stm.commit (do stm.monad [|store| (stm.read store)] - (wrap (|> |store| - (..retrieve_mock_file! separator path) - (try\map (|>> product.right - (get@ #mock_can_execute)))))))) + (in (|> |store| + (..retrieve_mock_file! separator path) + (try\map (|>> product.right + (get@ #mock_can_execute)))))))) (def: (read path) (stm.commit (do stm.monad [|store| (stm.read store)] - (wrap (|> |store| - (..retrieve_mock_file! separator path) - (try\map (|>> product.right - (get@ #mock_content)))))))) + (in (|> |store| + (..retrieve_mock_file! separator path) + (try\map (|>> product.right + (get@ #mock_content)))))))) (def: (delete path) (stm.commit @@ -1301,10 +1301,10 @@ (#try.Success |store|) (do ! [_ (stm.write |store| store)] - (wrap (#try.Success []))) + (in (#try.Success []))) (#try.Failure error) - (wrap (#try.Failure error)))))) + (in (#try.Failure error)))))) )))) (def: (check_or_make_directory monad fs path) @@ -1312,7 +1312,7 @@ (do monad [? (\ fs directory? path)] (if ? - (wrap (#try.Success [])) + (in (#try.Success [])) (\ fs make_directory path)))) (def: #export (make_directories monad fs path) @@ -1323,11 +1323,11 @@ (list.drop 1 segments) segments) #.Nil - (\ monad wrap (exception.throw ..cannot_make_directory [path])) + (\ monad in (exception.except ..cannot_make_directory [path])) (#.Cons head tail) (case head - "" (\ monad wrap (exception.throw ..cannot_make_directory [path])) + "" (\ monad in (exception.except ..cannot_make_directory [path])) _ (loop [current (if rooted? (format (\ fs separator) head) head) @@ -1338,19 +1338,19 @@ (#try.Success _) (case next #.Nil - (wrap (#try.Success [])) + (in (#try.Success [])) (#.Cons head tail) (recur (format current (\ fs separator) head) tail)) (#try.Failure error) - (wrap (#try.Failure error))))))))) + (in (#try.Failure error))))))))) (def: #export (make_file monad fs content path) (All [!] (-> (Monad !) (System !) Binary Path (! (Try Any)))) (do monad [? (\ fs file? path)] (if ? - (wrap (exception.throw ..cannot_make_file [path])) + (in (exception.except ..cannot_make_file [path])) (\ fs write content path)))) diff --git a/stdlib/source/library/lux/world/file/watch.lux b/stdlib/source/library/lux/world/file/watch.lux index 60b4f630c..daa1380a4 100644 --- a/stdlib/source/library/lux/world/file/watch.lux +++ b/stdlib/source/library/lux/world/file/watch.lux @@ -113,10 +113,10 @@ (#.Some [old_concern last_modified]) (do ! [_ (stm.update (dictionary.put path [new_concern last_modified]) tracker)] - (wrap true)) + (in true)) #.None - (wrap false)))) + (in false)))) (def: (file_tracker fs directory) (-> (//.System Async) //.Path (Async (Try File_Tracker))) @@ -126,7 +126,7 @@ (function (_ file tracker) (do ! [last_modified (\ fs last_modified file)] - (wrap (dictionary.put file last_modified tracker)))) + (in (dictionary.put file last_modified tracker)))) (: File_Tracker (dictionary.new text.hash)) files))) @@ -164,23 +164,23 @@ modifications (list.all (function (_ [path current_modification]) (do maybe.monad [previous_modification (dictionary.get path file_tracker)] - (wrap [path previous_modification current_modification]))) + (in [path previous_modification current_modification]))) current_files)]] - (wrap [[directory - [concern - (let [with_deletions (list\fold dictionary.remove file_tracker deletions) - with_creations (list\fold (function (_ [path last_modified] tracker) - (dictionary.put path last_modified tracker)) - with_deletions - creations) - with_modifications (list\fold (function (_ [path previous_modification current_modification] tracker) - (dictionary.put path current_modification tracker)) - with_creations - modifications)] - with_modifications)]] - [creations - modifications - deletions]]))) + (in [[directory + [concern + (let [with_deletions (list\fold dictionary.remove file_tracker deletions) + with_creations (list\fold (function (_ [path last_modified] tracker) + (dictionary.put path last_modified tracker)) + with_deletions + creations) + with_modifications (list\fold (function (_ [path previous_modification current_modification] tracker) + (dictionary.put path current_modification tracker)) + with_creations + modifications)] + with_modifications)]] + [creations + modifications + deletions]]))) (def: #export (polling fs) (-> (//.System Async) (Watcher Async)) @@ -194,23 +194,23 @@ (do ! [updated? (stm.commit (..update_watch! new_concern path tracker))] (if updated? - (wrap (#try.Success [])) + (in (#try.Success [])) (do (try.with !) [file_tracker (..file_tracker fs path)] (do ! [_ (stm.commit (stm.update (dictionary.put path [new_concern file_tracker]) tracker))] - (wrap (#try.Success [])))))) - (wrap (exception.throw ..cannot_poll_a_non_existent_directory [path]))))) + (in (#try.Success [])))))) + (in (exception.except ..cannot_poll_a_non_existent_directory [path]))))) (def: (concern path) (stm.commit (do stm.monad [@tracker (stm.read tracker)] - (wrap (case (dictionary.get path @tracker) - (#.Some [concern file_tracker]) - (#try.Success concern) + (in (case (dictionary.get path @tracker) + (#.Some [concern file_tracker]) + (#try.Success concern) - #.None - (exception.throw ..not_being_watched [path])))))) + #.None + (exception.except ..not_being_watched [path])))))) (def: (stop path) (stm.commit (do {! stm.monad} @@ -219,10 +219,10 @@ (#.Some [concern file_tracker]) (do ! [_ (stm.update (dictionary.remove path) tracker)] - (wrap (#try.Success concern))) + (in (#try.Success concern))) #.None - (wrap (exception.throw ..not_being_watched [path])))))) + (in (exception.except ..not_being_watched [path])))))) (def: (poll _) (do async.monad [@tracker (stm.commit (stm.read tracker))] @@ -235,7 +235,7 @@ (list\map product.left) (dictionary.of_list text.hash)) tracker))] - (wrap (#try.Success []))) + (in (#try.Success []))) #let [[creations modifications deletions] (list\fold (function (_ [_ [creations modifications deletions]] [all_creations all_modifications all_deletions]) @@ -244,14 +244,14 @@ (list\compose deletions all_deletions)]) [(list) (list) (list)] changes)]] - (wrap ($_ list\compose - (list\map (|>> product.left [..creation]) creations) - (|> modifications - (list.only (function (_ [path previous_modification current_modification]) - (not (instant\= previous_modification current_modification)))) - (list\map (|>> product.left [..modification]))) - (list\map (|>> [..deletion]) deletions) - ))))) + (in ($_ list\compose + (list\map (|>> product.left [..creation]) creations) + (|> modifications + (list.only (function (_ [path previous_modification current_modification]) + (not (instant\= previous_modification current_modification)))) + (list\map (|>> product.left [..modification]))) + (list\map (|>> [..deletion]) deletions) + ))))) ))) (def: #export (mock separator) @@ -389,7 +389,7 @@ (recur output))) #.None - (wrap output))))) + (in output))))) (def: (watch_events concern) (-> Concern (List Watch_Event)) @@ -423,36 +423,36 @@ [_ (async.future (java/nio/file/WatchKey::cancel key)) _ (stm.commit (stm.update (dictionary.remove path) tracker))] - (wrap (#try.Success concern))) + (in (#try.Success concern))) #.None - (wrap (exception.throw ..not_being_watched [path]))))))]] - (wrap (: (Watcher Async) - (implementation - (def: (start concern path) - (do async.monad - [?concern (stop path)] - (do (try.with async.monad) - [key (..default_start (..watch_events (..also (try.default ..none ?concern) - concern)) - watcher - path)] - (do async.monad - [_ (stm.commit (stm.update (dictionary.put path [concern key]) tracker))] - (wrap (#try.Success [])))))) - (def: (concern path) - (do async.monad - [@tracker (stm.commit (stm.read tracker))] - (case (dictionary.get path @tracker) - (#.Some [concern key]) - (wrap (#try.Success concern)) - - #.None - (wrap (exception.throw ..not_being_watched [path]))))) - (def: stop stop) - (def: (poll _) - (async.future (..default_poll watcher))) - ))))) + (in (exception.except ..not_being_watched [path]))))))]] + (in (: (Watcher Async) + (implementation + (def: (start concern path) + (do async.monad + [?concern (stop path)] + (do (try.with async.monad) + [key (..default_start (..watch_events (..also (try.default ..none ?concern) + concern)) + watcher + path)] + (do async.monad + [_ (stm.commit (stm.update (dictionary.put path [concern key]) tracker))] + (in (#try.Success [])))))) + (def: (concern path) + (do async.monad + [@tracker (stm.commit (stm.read tracker))] + (case (dictionary.get path @tracker) + (#.Some [concern key]) + (in (#try.Success concern)) + + #.None + (in (exception.except ..not_being_watched [path]))))) + (def: stop stop) + (def: (poll _) + (async.future (..default_poll watcher))) + ))))) )] (for {@.old (as_is <jvm>) @.jvm (as_is <jvm>)} diff --git a/stdlib/source/library/lux/world/net/http/client.lux b/stdlib/source/library/lux/world/net/http/client.lux index 2a160d0fd..02cc6ed91 100644 --- a/stdlib/source/library/lux/world/net/http/client.lux +++ b/stdlib/source/library/lux/world/net/http/client.lux @@ -114,7 +114,7 @@ (case> [_ 0] (do (try.with io.monad) [_ (java/lang/AutoCloseable::close input)] - (wrap ..empty_body)) + (in ..empty_body)) [partial? buffer_size] (let [buffer (binary.create buffer_size)] @@ -126,10 +126,10 @@ (case bytes_read -1 (do ! [_ (java/lang/AutoCloseable::close input)] - (wrap [(.nat so_far) buffer])) + (in [(.nat so_far) buffer])) +0 (recur so_far) _ (if (i.= remaining bytes_read) - (wrap [buffer_size buffer]) + (in [buffer_size buffer]) (recur (i.+ bytes_read so_far)))))) (loop [so_far +0 output (\ binary.monoid identity)] @@ -140,13 +140,13 @@ -1 (do ! [_ (java/lang/AutoCloseable::close input)] (case so_far - +0 (wrap (..body_of output)) + +0 (in (..body_of output)) _ (|> buffer (binary.slice 0 (.nat so_far)) (\ try.functor map (|>> (\ binary.monoid compose output) ..body_of)) - (\ io.monad wrap)))) + (\ io.monad in)))) +0 (recur so_far output) _ (if (i.= remaining bytes_read) (recur +0 @@ -168,7 +168,7 @@ (dictionary.put name (maybe.default "" ?value) headers))) #.None - (wrap headers))))) + (in headers))))) (implementation: #export default (Client IO) @@ -190,18 +190,18 @@ _ (java/io/OutputStream::write data stream) _ (java/io/OutputStream::flush stream) _ (java/lang/AutoCloseable::close stream)] - (wrap [])) + (in [])) #.None - (wrap [])) + (in [])) status (java/net/HttpURLConnection::getResponseCode connection) headers (..default_headers connection) input (|> connection java/net/URLConnection::getInputStream (\ ! map (|>> java/io/BufferedInputStream::new)))] - (wrap [(.nat status) - {#//.headers headers - #//.body (..default_body input)}]))))))] + (in [(.nat status) + {#//.headers headers + #//.body (..default_body input)}]))))))] (for {@.old (as_is <jvm>) @.jvm (as_is <jvm>)} (as_is))) diff --git a/stdlib/source/library/lux/world/net/http/cookie.lux b/stdlib/source/library/lux/world/net/http/cookie.lux index 08a75fecc..1254923b8 100644 --- a/stdlib/source/library/lux/world/net/http/cookie.lux +++ b/stdlib/source/library/lux/world/net/http/cookie.lux @@ -72,7 +72,7 @@ [key (l.slice (l.many! (l.none-of! "="))) _ (l.this "=") value (l.slice (l.many! (l.none-of! ";")))] - (wrap (dictionary.put key value context)))) + (in (dictionary.put key value context)))) (def: (cookies context) (-> Context (Parser Context)) @@ -81,7 +81,7 @@ [context' (..cookie context) _ (l.this "; ")] (cookies context')) - (p\wrap context))) + (p\in context))) (def: #export (get header) (-> Text (Try Context)) diff --git a/stdlib/source/library/lux/world/net/http/query.lux b/stdlib/source/library/lux/world/net/http/query.lux index b6b8936b7..4ee1c2cc2 100644 --- a/stdlib/source/library/lux/world/net/http/query.lux +++ b/stdlib/source/library/lux/world/net/http/query.lux @@ -26,25 +26,25 @@ ($_ p.either (p.after (p.either l.end (l.this "&")) - (wrap head)) + (in head)) (do ! [_ (l.this "+") tail component] - (wrap (format head " " tail))) + (in (format head " " tail))) (do ! [_ (l.this "%") code (|> (l.exactly 2 l.hexadecimal) (p.codec nat.hex) (\ ! map text.from-code)) tail component] - (wrap (format head code tail)))))))) + (in (format head code tail)))))))) (def: (form context) (-> Context (Parser Context)) ($_ p.either (do p.monad [_ l.end] - (wrap context)) + (in context)) (do {! p.monad} [key (l.some (l.none-of "=&;")) key (l.local key ..component)] @@ -58,7 +58,7 @@ l.end)] (form (dictionary.put key "" context))))) ## if invalid form data, just stop parsing... - (\ p.monad wrap context))) + (\ p.monad in context))) (def: #export (parameters raw) (-> Text (Try Context)) diff --git a/stdlib/source/library/lux/world/net/http/request.lux b/stdlib/source/library/lux/world/net/http/request.lux index b51e1af60..2c08a7cca 100644 --- a/stdlib/source/library/lux/world/net/http/request.lux +++ b/stdlib/source/library/lux/world/net/http/request.lux @@ -48,7 +48,7 @@ (-> Body (Async (Try Text))) (do async.monad [blobs (frp.consume body)] - (wrap (\ encoding.utf8 decode (merge blobs))))) + (in (\ encoding.utf8 decode (merge blobs))))) (def: failure (//response.bad-request "")) @@ -89,8 +89,8 @@ (case (do try.monad [query (//query.parameters query) input (context.run query property)] - (wrap [[identification protocol (set@ #//.uri uri resource) message] - input])) + (in [[identification protocol (set@ #//.uri uri resource) message] + input])) (#try.Success [request input]) (server input request) diff --git a/stdlib/source/library/lux/world/net/http/response.lux b/stdlib/source/library/lux/world/net/http/response.lux index ae96134b9..c32094707 100644 --- a/stdlib/source/library/lux/world/net/http/response.lux +++ b/stdlib/source/library/lux/world/net/http/response.lux @@ -29,34 +29,34 @@ (def: #export empty (-> Status Response) - (let [body (frp\wrap (\ encoding.utf8 encode ""))] + (let [body (frp\in (\ encoding.utf8 encode ""))] (function (_ status) [status {#//.headers (|> context.empty - (header.content-length 0) - (header.content-type mime.utf-8)) + (header.content_length 0) + (header.content_type mime.utf_8)) #//.body body}]))) -(def: #export (temporary-redirect to) +(def: #export (temporary_redirect to) (-> URL Response) - (let [[status message] (..empty status.temporary-redirect)] + (let [[status message] (..empty status.temporary_redirect)] [status (update@ #//.headers (header.location to) message)])) -(def: #export not-found +(def: #export not_found Response - (..empty status.not-found)) + (..empty status.not_found)) (def: #export (content status type data) (-> Status MIME Binary Response) [status {#//.headers (|> context.empty - (header.content-length (binary.size data)) - (header.content-type type)) - #//.body (frp\wrap data)}]) + (header.content_length (binary.size data)) + (header.content_type type)) + #//.body (frp\in data)}]) -(def: #export bad-request +(def: #export bad_request (-> Text Response) - (|>> (\ encoding.utf8 encode) (content status.bad-request mime.utf-8))) + (|>> (\ encoding.utf8 encode) (content status.bad_request mime.utf_8))) (def: #export ok (-> MIME Binary Response) @@ -67,7 +67,7 @@ (-> <type> Response) (|>> <pre> (\ encoding.utf8 encode) (..ok <mime>)))] - [text Text mime.utf-8 (<|)] + [text Text mime.utf_8 (<|)] [html html.Document mime.html html.html] [css CSS mime.css css.css] [json JSON mime.json json\encode] diff --git a/stdlib/source/library/lux/world/net/http/route.lux b/stdlib/source/library/lux/world/net/http/route.lux index 857503a20..39d66cba0 100644 --- a/stdlib/source/library/lux/world/net/http/route.lux +++ b/stdlib/source/library/lux/world/net/http/route.lux @@ -71,4 +71,4 @@ #let [[status message] response]] (if (n.= //status.not-found status) (alternative request) - (wrap response))))) + (in response))))) diff --git a/stdlib/source/library/lux/world/program.lux b/stdlib/source/library/lux/world/program.lux index a540bf2b1..e90307894 100644 --- a/stdlib/source/library/lux/world/program.lux +++ b/stdlib/source/library/lux/world/program.lux @@ -58,15 +58,15 @@ entries (monad.map ! (function (_ name) (\ ! map (|>> [name]) (\ program variable name))) variables)] - (wrap (|> entries - (list.all (function (_ [name value]) - (case value - (#try.Success value) - (#.Some [name value]) - - (#try.Failure _) - #.None))) - (dictionary.of_list text.hash))))) + (in (|> entries + (list.all (function (_ [name value]) + (case value + (#try.Success value) + (#.Some [name value]) + + (#try.Failure _) + #.None))) + (dictionary.of_list text.hash))))) (`` (implementation: #export (async program) (-> (Program IO) (Program Async)) @@ -100,7 +100,7 @@ (#try.Success value) #.None - (exception.throw ..unknown_environment_variable [name])))) + (exception.except ..unknown_environment_variable [name])))) (def: home home) (def: directory @@ -252,13 +252,13 @@ (do ! [?output (LuaFile::read ["*l"] file) _ (LuaFile::close [] file)] - (wrap (maybe.default default ?output))) + (in (maybe.default default ?output))) #.None - (wrap default)) + (in default)) (#try.Failure _) - (wrap default))))) + (in default))))) @.ruby (as_is (ffi.import: Env #as RubyEnv ["#::." (#static keys [] (Array Text)) @@ -329,7 +329,7 @@ io.io) ## @.php (do io.monad ## [environment (..getenv/0 [])] - ## (wrap (|> environment + ## (in (|> environment ## ..array_keys ## array.to_list ## (list\map (function (_ variable) @@ -340,7 +340,7 @@ ## (loop [input input ## output environment.empty] ## (if ("scheme object nil?" input) - ## (wrap output) + ## (in output) ## (let [entry (..head input)] ## (recur (..tail input) ## (dictionary.put (..car entry) (..cdr entry) output)))))) @@ -350,12 +350,12 @@ (template.let [(!fetch <method>) [(do io.monad [value (<method> name)] - (wrap (case value - (#.Some value) - (#try.Success value) + (in (case value + (#.Some value) + (#try.Success value) - #.None - (exception.throw ..unknown_environment_variable [name]))))]] + #.None + (exception.except ..unknown_environment_variable [name]))))]] (with_expansions [<jvm> (!fetch java/lang/System::resolveEnv)] (for {@.old <jvm> @.jvm <jvm> @@ -368,8 +368,8 @@ (#try.Success value) #.None - (exception.throw ..unknown_environment_variable [name])) - (exception.throw ..unknown_environment_variable [name]))) + (exception.except ..unknown_environment_variable [name])) + (exception.except ..unknown_environment_variable [name]))) @.python (!fetch os/environ::get) @.lua (!fetch os/getenv) @.ruby (!fetch RubyEnv::fetch) @@ -391,7 +391,7 @@ @.ruby (io.io (RubyDir::home)) ## @.php (do io.monad ## [output (..getenv/1 ["HOME"])] - ## (wrap (if (bit\= false (:as Bit output)) + ## (in (if (bit\= false (:as Bit output)) ## "~" ## output))) } @@ -418,11 +418,11 @@ on_windows (..run_command default "cd")] (if (is? default on_windows) (..run_command default "pwd") - (wrap on_windows))) + (in on_windows))) @.ruby (io.io (RubyFileUtils::pwd)) ## @.php (do io.monad ## [output (..getcwd [])] - ## (wrap (if (bit\= false (:as Bit output)) + ## (in (if (bit\= false (:as Bit output)) ## "." ## output))) } @@ -432,7 +432,7 @@ (def: (exit code) (with_expansions [<jvm> (do io.monad [_ (java/lang/System::exit code)] - (wrap (undefined)))] + (in (undefined)))] (for {@.old <jvm> @.jvm <jvm> @.js (cond ffi.on_node_js? diff --git a/stdlib/source/library/lux/world/shell.lux b/stdlib/source/library/lux/world/shell.lux index b186f27a8..c9f524a69 100644 --- a/stdlib/source/library/lux/world/shell.lux +++ b/stdlib/source/library/lux/world/shell.lux @@ -89,7 +89,7 @@ (async.future (do (try.with io.monad) [process (\ shell execute input)] - (wrap (..async_process process))))))) + (in (..async_process process))))))) ## https://en.wikipedia.org/wiki/Code_injection#Shell_injection (interface: (Policy ?) @@ -238,31 +238,31 @@ jvm_error (|> jvm_error java/io/InputStreamReader::new java/io/BufferedReader::new)]] - (wrap (: (Process IO) - (`` (implementation - (~~ (template [<name> <stream>] - [(def: (<name> _) - (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] - )) - (def: (write message) - (java/io/OutputStream::write (\ utf8.codec encode message) jvm_output)) - (~~ (template [<name> <method>] - [(def: (<name> _) - (<method> process))] - - [destroy java/lang/Process::destroy] - [await java/lang/Process::waitFor] - )))))))) + (in (: (Process IO) + (`` (implementation + (~~ (template [<name> <stream>] + [(def: (<name> _) + (do ! + [output (java/io/BufferedReader::readLine <stream>)] + (case output + (#.Some output) + (in output) + + #.None + (\ io.monad in (exception.except ..no_more_output [])))))] + + [read jvm_input] + [error jvm_error] + )) + (def: (write message) + (java/io/OutputStream::write (\ utf8.codec encode message) jvm_output)) + (~~ (template [<name> <method>] + [(def: (<name> _) + (<method> process))] + + [destroy java/lang/Process::destroy] + [await java/lang/Process::waitFor] + )))))))) (import: java/io/File ["#::." @@ -298,7 +298,7 @@ _ (|> builder java/lang/ProcessBuilder::environment (\ try.functor map (..jvm::load_environment environment)) - (\ io.monad wrap)) + (\ io.monad in)) process (java/lang/ProcessBuilder::start builder)] (..default_process process)))) )] @@ -329,10 +329,10 @@ (#try.Success [|state| output]) (do ! [_ (atom.write |state| state)] - (wrap (#try.Success output))) + (in (#try.Success output))) (#try.Failure error) - (wrap (#try.Failure error)))))] + (in (#try.Failure error)))))] [read on_read] [error on_error] @@ -345,10 +345,10 @@ (#try.Success |state|) (do ! [_ (atom.write |state| state)] - (wrap (#try.Success []))) + (in (#try.Success []))) (#try.Failure error) - (wrap (#try.Failure error))))) + (in (#try.Failure error))))) (def: (destroy _) (do {! io.monad} [|state| (atom.read state)] @@ -356,10 +356,10 @@ (#try.Success |state|) (do ! [_ (atom.write |state| state)] - (wrap (#try.Success []))) + (in (#try.Success []))) (#try.Failure error) - (wrap (#try.Failure error))))))) + (in (#try.Failure error))))))) (implementation: #export (mock mock init) (All [s] diff --git a/stdlib/source/poly/lux/abstract/equivalence.lux b/stdlib/source/poly/lux/abstract/equivalence.lux index 1f414e197..b1d4f413f 100644 --- a/stdlib/source/poly/lux/abstract/equivalence.lux +++ b/stdlib/source/poly/lux/abstract/equivalence.lux @@ -54,8 +54,8 @@ (~~ (template [<matcher> <eq>] [(do ! [_ <matcher>] - (wrap (` (: (~ (@Equivalence inputT)) - <eq>))))] + (in (` (: (~ (@Equivalence inputT)) + <eq>))))] [(<type>.exactly Any) (function ((~ g!_) (~ g!_) (~ g!_)) #1)] [(<type>.sub Bit) (~! bit.equivalence)] @@ -69,8 +69,8 @@ [(do ! [[_ argC] (<type>.applied (<>.and (<type>.exactly <name>) equivalence))] - (wrap (` (: (~ (@Equivalence inputT)) - (<eq> (~ argC))))))] + (in (` (: (~ (@Equivalence inputT)) + (<eq> (~ argC))))))] [.Maybe (~! maybe.equivalence)] [.List (~! list.equivalence)] @@ -85,14 +85,14 @@ (<type>.exactly dictionary.Dictionary) <type>.any equivalence))] - (wrap (` (: (~ (@Equivalence inputT)) - ((~! dictionary.equivalence) (~ valC)))))) + (in (` (: (~ (@Equivalence inputT)) + ((~! dictionary.equivalence) (~ valC)))))) ## Models (~~ (template [<type> <eq>] [(do ! [_ (<type>.exactly <type>)] - (wrap (` (: (~ (@Equivalence inputT)) - <eq>))))] + (in (` (: (~ (@Equivalence inputT)) + <eq>))))] [duration.Duration duration.equivalence] [instant.Instant instant.equivalence] @@ -103,8 +103,8 @@ (do ! [_ (<type>.applied (<>.and (<type>.exactly unit.Qty) <type>.any))] - (wrap (` (: (~ (@Equivalence inputT)) - unit.equivalence)))) + (in (` (: (~ (@Equivalence inputT)) + unit.equivalence)))) ## Variants (do ! [members (<type>.variant (<>.many equivalence)) @@ -112,20 +112,20 @@ g!_ (code.local_identifier "_____________") g!left (code.local_identifier "_____________left") g!right (code.local_identifier "_____________right")]] - (wrap (` (: (~ (@Equivalence inputT)) - (function ((~ g!_) (~ g!left) (~ g!right)) - (case [(~ g!left) (~ g!right)] - (~+ (list\join (list\map (function (_ [tag g!eq]) - (if (nat.= last tag) - (list (` [((~ (code.nat (dec tag))) #1 (~ g!left)) - ((~ (code.nat (dec tag))) #1 (~ g!right))]) - (` ((~ g!eq) (~ g!left) (~ g!right)))) - (list (` [((~ (code.nat tag)) #0 (~ g!left)) - ((~ (code.nat tag)) #0 (~ g!right))]) - (` ((~ g!eq) (~ g!left) (~ g!right)))))) - (list.enumeration members)))) - (~ g!_) - #0)))))) + (in (` (: (~ (@Equivalence inputT)) + (function ((~ g!_) (~ g!left) (~ g!right)) + (case [(~ g!left) (~ g!right)] + (~+ (list\join (list\map (function (_ [tag g!eq]) + (if (nat.= last tag) + (list (` [((~ (code.nat (dec tag))) #1 (~ g!left)) + ((~ (code.nat (dec tag))) #1 (~ g!right))]) + (` ((~ g!eq) (~ g!left) (~ g!right)))) + (list (` [((~ (code.nat tag)) #0 (~ g!left)) + ((~ (code.nat tag)) #0 (~ g!right))]) + (` ((~ g!eq) (~ g!left) (~ g!right)))))) + (list.enumeration members)))) + (~ g!_) + #0)))))) ## Tuples (do ! [g!eqs (<type>.tuple (<>.many equivalence)) @@ -133,33 +133,33 @@ indices (list.indices (list.size g!eqs)) g!lefts (list\map (|>> nat\encode (text\compose "left") code.local_identifier) indices) g!rights (list\map (|>> nat\encode (text\compose "right") code.local_identifier) indices)]] - (wrap (` (: (~ (@Equivalence inputT)) - (function ((~ g!_) [(~+ g!lefts)] [(~+ g!rights)]) - (and (~+ (|> (list.zipped/3 g!eqs g!lefts g!rights) - (list\map (function (_ [g!eq g!left g!right]) - (` ((~ g!eq) (~ g!left) (~ g!right))))))))))))) + (in (` (: (~ (@Equivalence inputT)) + (function ((~ g!_) [(~+ g!lefts)] [(~+ g!rights)]) + (and (~+ (|> (list.zipped/3 g!eqs g!lefts g!rights) + (list\map (function (_ [g!eq g!left g!right]) + (` ((~ g!eq) (~ g!left) (~ g!right))))))))))))) ## Type recursion (do ! [[g!self bodyC] (<type>.recursive equivalence) #let [g!_ (code.local_identifier "_____________")]] - (wrap (` (: (~ (@Equivalence inputT)) - ((~! /.rec) (.function ((~ g!_) (~ g!self)) - (~ bodyC))))))) + (in (` (: (~ (@Equivalence inputT)) + ((~! /.rec) (.function ((~ g!_) (~ g!self)) + (~ bodyC))))))) <type>.recursive_self ## Type applications (do ! [[funcC argsC] (<type>.applied (<>.and equivalence (<>.many equivalence)))] - (wrap (` ((~ funcC) (~+ argsC))))) + (in (` ((~ funcC) (~+ argsC))))) ## Parameters <type>.parameter ## Polymorphism (do ! [[funcC varsC bodyC] (<type>.polymorphic equivalence)] - (wrap (` (: (All [(~+ varsC)] - (-> (~+ (list\map (|>> (~) ((~! /.Equivalence)) (`)) varsC)) - ((~! /.Equivalence) ((~ (poly.to_code *env* inputT)) (~+ varsC))))) - (function ((~ funcC) (~+ varsC)) - (~ bodyC)))))) + (in (` (: (All [(~+ varsC)] + (-> (~+ (list\map (|>> (~) ((~! /.Equivalence)) (`)) varsC)) + ((~! /.Equivalence) ((~ (poly.to_code *env* inputT)) (~+ varsC))))) + (function ((~ funcC) (~+ varsC)) + (~ bodyC)))))) <type>.recursive_call ## If all else fails... (|> <type>.any diff --git a/stdlib/source/poly/lux/abstract/functor.lux b/stdlib/source/poly/lux/abstract/functor.lux index 363b43b8a..089d5119b 100644 --- a/stdlib/source/poly/lux/abstract/functor.lux +++ b/stdlib/source/poly/lux/abstract/functor.lux @@ -48,20 +48,20 @@ (do p.monad [#let [varI (|> num_vars (n.* 2) dec)] _ (<type>.parameter! varI)] - (wrap (` ((~ funcC) (~ valueC))))) + (in (` ((~ funcC) (~ valueC))))) ## Variants (do ! - [_ (wrap []) + [_ (in []) membersC (<type>.variant (p.many (Arg<?> valueC))) #let [last (dec (list.size membersC))]] - (wrap (` (case (~ valueC) - (~+ (list\join (list\map (function (_ [tag memberC]) - (if (n.= last tag) - (list (` ((~ (code.nat (dec tag))) #1 (~ valueC))) - (` ((~ (code.nat (dec tag))) #1 (~ memberC)))) - (list (` ((~ (code.nat tag)) #0 (~ valueC))) - (` ((~ (code.nat tag)) #0 (~ memberC)))))) - (list.enumeration membersC)))))))) + (in (` (case (~ valueC) + (~+ (list\join (list\map (function (_ [tag memberC]) + (if (n.= last tag) + (list (` ((~ (code.nat (dec tag))) #1 (~ valueC))) + (` ((~ (code.nat (dec tag))) #1 (~ memberC)))) + (list (` ((~ (code.nat tag)) #0 (~ valueC))) + (` ((~ (code.nat tag)) #0 (~ memberC)))))) + (list.enumeration membersC)))))))) ## Tuples (do p.monad [pairsCC (: (<type>.Parser (List [Code Code])) @@ -70,17 +70,17 @@ (list))] (p.either (let [slotC (|> idx %.nat (format "____________slot") code.local_identifier)] (do ! - [_ (wrap []) + [_ (in []) memberC (Arg<?> slotC)] (recur (inc idx) (list\compose pairsCC (list [slotC memberC]))))) - (wrap pairsCC)))))] - (wrap (` (case (~ valueC) - [(~+ (list\map product.left pairsCC))] - [(~+ (list\map product.right pairsCC))])))) + (in pairsCC)))))] + (in (` (case (~ valueC) + [(~+ (list\map product.left pairsCC))] + [(~+ (list\map product.right pairsCC))])))) ## Functions (do ! - [_ (wrap []) + [_ (in []) #let [g! (code.local_identifier "____________") outL (code.local_identifier "____________outL")] [inT+ outC] (<type>.function (p.many <type>.any) @@ -88,23 +88,23 @@ #let [inC+ (|> (list.size inT+) list.indices (list\map (|>> %.nat (format "____________inC") code.local_identifier)))]] - (wrap (` (function ((~ g!) (~+ inC+)) - (let [(~ outL) ((~ valueC) (~+ inC+))] - (~ outC)))))) + (in (` (function ((~ g!) (~+ inC+)) + (let [(~ outL) ((~ valueC) (~+ inC+))] + (~ outC)))))) ## Recursion (do p.monad [_ <type>.recursive_call] - (wrap (` ((~' map) (~ funcC) (~ valueC))))) + (in (` ((~' map) (~ funcC) (~ valueC))))) ## Parameters (do p.monad [_ <type>.any] - (wrap valueC)) + (in valueC)) )))] [_ _ outputC] (: (<type>.Parser [Code (List Code) Code]) (p.either (<type>.polymorphic (Arg<?> inputC)) (p.failure (format "Cannot create Functor for: " (%.type inputT)))))] - (wrap (` (: (~ (@Functor inputT)) - (implementation - (def: ((~' map) (~ funcC) (~ inputC)) - (~ outputC)))))))) + (in (` (: (~ (@Functor inputT)) + (implementation + (def: ((~' map) (~ funcC) (~ inputC)) + (~ outputC)))))))) diff --git a/stdlib/source/poly/lux/data/format/json.lux b/stdlib/source/poly/lux/data/format/json.lux index 1aa793323..9ce3b6a6e 100644 --- a/stdlib/source/poly/lux/data/format/json.lux +++ b/stdlib/source/poly/lux/data/format/json.lux @@ -1,4 +1,5 @@ -(.module: {#.doc "Codecs for values in the JSON format."} +(.module: + {#.doc "Codecs for values in the JSON format."} [library [lux #* ["." debug] @@ -70,8 +71,8 @@ (do <>.monad [high </>.number low </>.number] - (wrap (n.+ (|> high frac.int .nat (i64.left_shift 32)) - (|> low frac.int .nat)))))))) + (in (n.+ (|> high frac.int .nat (i64.left_shift 32)) + (|> low frac.int .nat)))))))) (implementation: int_codec (codec.Codec JSON Int) @@ -105,8 +106,8 @@ [(do ! [#let [g!_ (code.local_identifier "_______")] _ <matcher>] - (wrap (` (: (~ (@JSON\encode inputT)) - <encoder>))))] + (in (` (: (~ (@JSON\encode inputT)) + <encoder>))))] [(<type>.exactly Any) (function ((~ g!_) (~ (code.identifier ["" "0"]))) #/.Null)] [(<type>.sub Bit) (|>> #/.Boolean)] @@ -117,8 +118,8 @@ <time> (template [<type> <codec>] [(do ! [_ (<type>.exactly <type>)] - (wrap (` (: (~ (@JSON\encode inputT)) - (|>> (\ (~! <codec>) (~' encode)) #/.String)))))] + (in (` (: (~ (@JSON\encode inputT)) + (|>> (\ (~! <codec>) (~' encode)) #/.String)))))] ## [duration.Duration duration.codec] ## [instant.Instant instant.codec] @@ -137,8 +138,8 @@ (do ! [unitT (<type>.applied (<>.after (<type>.exactly unit.Qty) <type>.any))] - (wrap (` (: (~ (@JSON\encode inputT)) - (\ (~! qty_codec) (~' encode)))))) + (in (` (: (~ (@JSON\encode inputT)) + (\ (~! qty_codec) (~' encode)))))) (do ! [#let [g!_ (code.local_identifier "_______") g!key (code.local_identifier "_______key") @@ -147,76 +148,76 @@ (<type>.exactly d.Dictionary) (<type>.exactly .Text) encode))] - (wrap (` (: (~ (@JSON\encode inputT)) - (|>> ((~! d.entries)) - ((~! list\map) (function ((~ g!_) [(~ g!key) (~ g!val)]) - [(~ g!key) ((~ =val=) (~ g!val))])) - ((~! d.of_list) (~! text.hash)) - #/.Object))))) + (in (` (: (~ (@JSON\encode inputT)) + (|>> ((~! d.entries)) + ((~! list\map) (function ((~ g!_) [(~ g!key) (~ g!val)]) + [(~ g!key) ((~ =val=) (~ g!val))])) + ((~! d.of_list) (~! text.hash)) + #/.Object))))) (do ! [[_ =sub=] (<type>.applied ($_ <>.and (<type>.exactly .Maybe) encode))] - (wrap (` (: (~ (@JSON\encode inputT)) - ((~! ..nullable) (~ =sub=)))))) + (in (` (: (~ (@JSON\encode inputT)) + ((~! ..nullable) (~ =sub=)))))) (do ! [[_ =sub=] (<type>.applied ($_ <>.and (<type>.exactly .List) encode))] - (wrap (` (: (~ (@JSON\encode inputT)) - (|>> ((~! list\map) (~ =sub=)) ((~! row.of_list)) #/.Array))))) + (in (` (: (~ (@JSON\encode inputT)) + (|>> ((~! list\map) (~ =sub=)) ((~! row.of_list)) #/.Array))))) (do ! [#let [g!_ (code.local_identifier "_______") g!input (code.local_identifier "_______input")] members (<type>.variant (<>.many encode)) #let [last (dec (list.size members))]] - (wrap (` (: (~ (@JSON\encode inputT)) - (function ((~ g!_) (~ g!input)) - (case (~ g!input) - (~+ (list\join (list\map (function (_ [tag g!encode]) - (if (n.= last tag) - (list (` ((~ (code.nat (dec tag))) #1 (~ g!input))) - (` ((~! /.json) [(~ (code.frac (..tag (dec tag)))) - #1 - ((~ g!encode) (~ g!input))]))) - (list (` ((~ (code.nat tag)) #0 (~ g!input))) - (` ((~! /.json) [(~ (code.frac (..tag tag))) - #0 - ((~ g!encode) (~ g!input))]))))) - (list.enumeration members)))))))))) + (in (` (: (~ (@JSON\encode inputT)) + (function ((~ g!_) (~ g!input)) + (case (~ g!input) + (~+ (list\join (list\map (function (_ [tag g!encode]) + (if (n.= last tag) + (list (` ((~ (code.nat (dec tag))) #1 (~ g!input))) + (` ((~! /.json) [(~ (code.frac (..tag (dec tag)))) + #1 + ((~ g!encode) (~ g!input))]))) + (list (` ((~ (code.nat tag)) #0 (~ g!input))) + (` ((~! /.json) [(~ (code.frac (..tag tag))) + #0 + ((~ g!encode) (~ g!input))]))))) + (list.enumeration members)))))))))) (do ! [g!encoders (<type>.tuple (<>.many encode)) #let [g!_ (code.local_identifier "_______") g!members (|> (list.size g!encoders) list.indices (list\map (|>> n\encode code.local_identifier)))]] - (wrap (` (: (~ (@JSON\encode inputT)) - (function ((~ g!_) [(~+ g!members)]) - ((~! /.json) [(~+ (list\map (function (_ [g!member g!encode]) - (` ((~ g!encode) (~ g!member)))) - (list.zipped/2 g!members g!encoders)))])))))) + (in (` (: (~ (@JSON\encode inputT)) + (function ((~ g!_) [(~+ g!members)]) + ((~! /.json) [(~+ (list\map (function (_ [g!member g!encode]) + (` ((~ g!encode) (~ g!member)))) + (list.zipped/2 g!members g!encoders)))])))))) ## Type recursion (do ! [[selfC non_recC] (<type>.recursive encode) #let [g! (code.local_identifier "____________")]] - (wrap (` (: (~ (@JSON\encode inputT)) - ((~! ..rec_encode) (.function ((~ g!) (~ selfC)) - (~ non_recC))))))) + (in (` (: (~ (@JSON\encode inputT)) + ((~! ..rec_encode) (.function ((~ g!) (~ selfC)) + (~ non_recC))))))) <type>.recursive_self ## Type applications (do ! [partsC (<type>.applied (<>.many encode))] - (wrap (` ((~+ partsC))))) + (in (` ((~+ partsC))))) ## Polymorphism (do ! [[funcC varsC bodyC] (<type>.polymorphic encode)] - (wrap (` (: (All [(~+ varsC)] - (-> (~+ (list\map (function (_ varC) (` (-> (~ varC) /.JSON))) - varsC)) - (-> ((~ (poly.to_code *env* inputT)) (~+ varsC)) - /.JSON))) - (function ((~ funcC) (~+ varsC)) - (~ bodyC)))))) + (in (` (: (All [(~+ varsC)] + (-> (~+ (list\map (function (_ varC) (` (-> (~ varC) /.JSON))) + varsC)) + (-> ((~ (poly.to_code *env* inputT)) (~+ varsC)) + /.JSON))) + (function ((~ funcC) (~+ varsC)) + (~ bodyC)))))) <type>.parameter <type>.recursive_call ## If all else fails... @@ -228,8 +229,8 @@ [<basic> (template [<matcher> <decoder>] [(do ! [_ <matcher>] - (wrap (` (: (~ (@JSON\decode inputT)) - (~! <decoder>)))))] + (in (` (: (~ (@JSON\decode inputT)) + (~! <decoder>)))))] [(<type>.exactly Any) </>.null] [(<type>.sub Bit) </>.boolean] @@ -240,8 +241,8 @@ <time> (template [<type> <codec>] [(do ! [_ (<type>.exactly <type>)] - (wrap (` (: (~ (@JSON\decode inputT)) - ((~! <>.codec) (~! <codec>) (~! </>.string))))))] + (in (` (: (~ (@JSON\decode inputT)) + ((~! <>.codec) (~! <codec>) (~! </>.string))))))] ## [duration.Duration duration.codec] ## [instant.Instant instant.codec] @@ -260,65 +261,65 @@ (do ! [unitT (<type>.applied (<>.after (<type>.exactly unit.Qty) <type>.any))] - (wrap (` (: (~ (@JSON\decode inputT)) - ((~! <>.codec) (~! qty_codec) (~! </>.any)))))) + (in (` (: (~ (@JSON\decode inputT)) + ((~! <>.codec) (~! qty_codec) (~! </>.any)))))) (do ! [[_ _ valC] (<type>.applied ($_ <>.and (<type>.exactly d.Dictionary) (<type>.exactly .Text) decode))] - (wrap (` (: (~ (@JSON\decode inputT)) - ((~! </>.dictionary) (~ valC)))))) + (in (` (: (~ (@JSON\decode inputT)) + ((~! </>.dictionary) (~ valC)))))) (do ! [[_ subC] (<type>.applied (<>.and (<type>.exactly .Maybe) decode))] - (wrap (` (: (~ (@JSON\decode inputT)) - ((~! </>.nullable) (~ subC)))))) + (in (` (: (~ (@JSON\decode inputT)) + ((~! </>.nullable) (~ subC)))))) (do ! [[_ subC] (<type>.applied (<>.and (<type>.exactly .List) decode))] - (wrap (` (: (~ (@JSON\decode inputT)) - ((~! </>.array) ((~! <>.some) (~ subC))))))) + (in (` (: (~ (@JSON\decode inputT)) + ((~! </>.array) ((~! <>.some) (~ subC))))))) (do ! [members (<type>.variant (<>.many decode)) #let [last (dec (list.size members))]] - (wrap (` (: (~ (@JSON\decode inputT)) - ($_ ((~! <>.or)) - (~+ (list\map (function (_ [tag memberC]) - (if (n.= last tag) - (` (|> (~ memberC) - ((~! <>.after) ((~! </>.boolean!) (~ (code.bit #1)))) - ((~! <>.after) ((~! </>.number!) (~ (code.frac (..tag (dec tag)))))) - ((~! </>.array)))) - (` (|> (~ memberC) - ((~! <>.after) ((~! </>.boolean!) (~ (code.bit #0)))) - ((~! <>.after) ((~! </>.number!) (~ (code.frac (..tag tag))))) - ((~! </>.array)))))) - (list.enumeration members)))))))) + (in (` (: (~ (@JSON\decode inputT)) + ($_ ((~! <>.or)) + (~+ (list\map (function (_ [tag memberC]) + (if (n.= last tag) + (` (|> (~ memberC) + ((~! <>.after) ((~! </>.boolean!) (~ (code.bit #1)))) + ((~! <>.after) ((~! </>.number!) (~ (code.frac (..tag (dec tag)))))) + ((~! </>.array)))) + (` (|> (~ memberC) + ((~! <>.after) ((~! </>.boolean!) (~ (code.bit #0)))) + ((~! <>.after) ((~! </>.number!) (~ (code.frac (..tag tag))))) + ((~! </>.array)))))) + (list.enumeration members)))))))) (do ! [g!decoders (<type>.tuple (<>.many decode))] - (wrap (` (: (~ (@JSON\decode inputT)) - ((~! </>.array) ($_ ((~! <>.and)) (~+ g!decoders))))))) + (in (` (: (~ (@JSON\decode inputT)) + ((~! </>.array) ($_ ((~! <>.and)) (~+ g!decoders))))))) ## Type recursion (do ! [[selfC bodyC] (<type>.recursive decode) #let [g! (code.local_identifier "____________")]] - (wrap (` (: (~ (@JSON\decode inputT)) - ((~! <>.rec) (.function ((~ g!) (~ selfC)) - (~ bodyC))))))) + (in (` (: (~ (@JSON\decode inputT)) + ((~! <>.rec) (.function ((~ g!) (~ selfC)) + (~ bodyC))))))) <type>.recursive_self ## Type applications (do ! [[funcC argsC] (<type>.applied (<>.and decode (<>.many decode)))] - (wrap (` ((~ funcC) (~+ argsC))))) + (in (` ((~ funcC) (~+ argsC))))) ## Polymorphism (do ! [[funcC varsC bodyC] (<type>.polymorphic decode)] - (wrap (` (: (All [(~+ varsC)] - (-> (~+ (list\map (|>> (~) </>.Parser (`)) varsC)) - (</>.Parser ((~ (poly.to_code *env* inputT)) (~+ varsC))))) - (function ((~ funcC) (~+ varsC)) - (~ bodyC)))))) + (in (` (: (All [(~+ varsC)] + (-> (~+ (list\map (|>> (~) </>.Parser (`)) varsC)) + (</>.Parser ((~ (poly.to_code *env* inputT)) (~+ varsC))))) + (function ((~ funcC) (~+ varsC)) + (~ bodyC)))))) <type>.parameter <type>.recursive_call ## If all else fails... @@ -343,10 +344,10 @@ #dictionary (Dictionary Text Frac)}) (derived: (..codec Record)))} - (wrap (list (` (: (codec.Codec /.JSON (~ inputT)) - (implementation - (def: (~' encode) - ((~! ..encode) (~ inputT))) - (def: (~' decode) - ((~! </>.run) ((~! ..decode) (~ inputT)))) - )))))) + (in (list (` (: (codec.Codec /.JSON (~ inputT)) + (implementation + (def: (~' encode) + ((~! ..encode) (~ inputT))) + (def: (~' decode) + ((~! </>.run) ((~! ..decode) (~ inputT)))) + )))))) diff --git a/stdlib/source/program/aedifex.lux b/stdlib/source/program/aedifex.lux index c84f57170..664883ab0 100644 --- a/stdlib/source/program/aedifex.lux +++ b/stdlib/source/program/aedifex.lux @@ -85,13 +85,13 @@ [exit_code output] ((command console program (file.async file.default) (shell.async shell.default) resolution) profile) _ (case exit_code (^ (static shell.normal)) - (wrap []) + (in []) _ (do async.monad [_ (\ program exit exit_code)] - (wrap (#try.Failure ""))))] - (wrap output))) + (in (#try.Failure ""))))] + (in output))) (exception: (cannot_find_repository {repository Text} {options (Dictionary Text Address)}) @@ -122,7 +122,7 @@ (#try.Failure error) (..fail! error)))) - (\ io.monad wrap []))) + (\ io.monad in []))) (program: [{[profile operation] /cli.command}] (do {! io.monad} @@ -148,7 +148,7 @@ (let [program (program.async program.default)] (case operation #/cli.Version - (wrap []) + (in []) #/cli.Clean (..command @@ -175,10 +175,10 @@ profile) [#.None _] - (async\wrap (exception.throw /.no_identity [])) + (async\in (exception.except /.no_identity [])) [_ #.None] - (async\wrap (exception.throw ..cannot_find_repository [repository (get@ #/.deploy_repositories profile)])))) + (async\in (exception.except ..cannot_find_repository [repository (get@ #/.deploy_repositories profile)])))) #/cli.Dependencies (..command diff --git a/stdlib/source/program/aedifex/artifact/snapshot.lux b/stdlib/source/program/aedifex/artifact/snapshot.lux index b377c1b38..6a5849f43 100644 --- a/stdlib/source/program/aedifex/artifact/snapshot.lux +++ b/stdlib/source/program/aedifex/artifact/snapshot.lux @@ -51,7 +51,7 @@ (def: local_copy_parser (Parser Any) (<| (<xml>.node ..<local_copy>) - (<text>.embed (<text>.this ..local_copy_value)) + (<text>.then (<text>.this ..local_copy_value)) <xml>.text)) (def: #export (format snapshot) diff --git a/stdlib/source/program/aedifex/artifact/snapshot/build.lux b/stdlib/source/program/aedifex/artifact/snapshot/build.lux index 0e8692054..37bb3ca2d 100644 --- a/stdlib/source/program/aedifex/artifact/snapshot/build.lux +++ b/stdlib/source/program/aedifex/artifact/snapshot/build.lux @@ -38,5 +38,5 @@ (def: #export parser (Parser Build) (<| (<xml>.node ..tag) - (<text>.embed (<>.codec nat.decimal (<text>.many <text>.decimal))) + (<text>.then (<>.codec nat.decimal (<text>.many <text>.decimal))) <xml>.text)) diff --git a/stdlib/source/program/aedifex/artifact/snapshot/stamp.lux b/stdlib/source/program/aedifex/artifact/snapshot/stamp.lux index 147369711..0e9cba494 100644 --- a/stdlib/source/program/aedifex/artifact/snapshot/stamp.lux +++ b/stdlib/source/program/aedifex/artifact/snapshot/stamp.lux @@ -46,7 +46,7 @@ (def: time_parser (Parser Time) (<| (<xml>.node <timestamp>) - (<text>.embed //time.parser) + (<text>.then //time.parser) <xml>.text)) (def: #export parser diff --git a/stdlib/source/program/aedifex/artifact/snapshot/time.lux b/stdlib/source/program/aedifex/artifact/snapshot/time.lux index 46c9b149e..08f8b8035 100644 --- a/stdlib/source/program/aedifex/artifact/snapshot/time.lux +++ b/stdlib/source/program/aedifex/artifact/snapshot/time.lux @@ -43,4 +43,4 @@ [date ///time/date.parser _ (<text>.this ..separator) time ///time/time.parser] - (wrap [date time]))) + (in [date time]))) diff --git a/stdlib/source/program/aedifex/artifact/snapshot/version.lux b/stdlib/source/program/aedifex/artifact/snapshot/version.lux index 89af452e2..c1341cf98 100644 --- a/stdlib/source/program/aedifex/artifact/snapshot/version.lux +++ b/stdlib/source/program/aedifex/artifact/snapshot/version.lux @@ -62,6 +62,6 @@ ($_ <>.and (<xml>.somewhere (..text ..<extension>)) (<xml>.somewhere (..text ..<value>)) - (<xml>.somewhere (<text>.embed ///time.parser - (..text ..<updated>))) + (<xml>.somewhere (<text>.then ///time.parser + (..text ..<updated>))) ))) diff --git a/stdlib/source/program/aedifex/artifact/time.lux b/stdlib/source/program/aedifex/artifact/time.lux index 524b68bb1..c8452a477 100644 --- a/stdlib/source/program/aedifex/artifact/time.lux +++ b/stdlib/source/program/aedifex/artifact/time.lux @@ -36,8 +36,8 @@ (-> Instant (Try Time)) (do try.monad [date (/date.date (instant.date instant))] - (wrap [date - (instant.time instant)]))) + (in [date + (instant.time instant)]))) (def: #export equivalence (Equivalence Time) @@ -54,4 +54,4 @@ (do <>.monad [date /date.parser time /time.parser] - (wrap [date time]))) + (in [date time]))) diff --git a/stdlib/source/program/aedifex/artifact/time/date.lux b/stdlib/source/program/aedifex/artifact/time/date.lux index f6b8ae5a9..b392a5569 100644 --- a/stdlib/source/program/aedifex/artifact/time/date.lux +++ b/stdlib/source/program/aedifex/artifact/time/date.lux @@ -51,7 +51,7 @@ (if (and (i.>= ..min_year year) (i.<= ..max_year year)) (#try.Success (:abstraction raw)) - (exception.throw ..year_is_out_of_range [(date.year raw)])))) + (exception.except ..year_is_out_of_range [(date.year raw)])))) (def: #export value (-> Date date.Date) @@ -79,4 +79,4 @@ month (<>.lift (month.by_number month)) day_of_month (<>.codec n.decimal (<text>.exactly 2 <text>.decimal)) date (<>.lift (date.date year month day_of_month))] - (wrap (:abstraction date))))) + (in (:abstraction date))))) diff --git a/stdlib/source/program/aedifex/artifact/versioning.lux b/stdlib/source/program/aedifex/artifact/versioning.lux index 9c9805571..37adedea1 100644 --- a/stdlib/source/program/aedifex/artifact/versioning.lux +++ b/stdlib/source/program/aedifex/artifact/versioning.lux @@ -77,7 +77,7 @@ (def: last_updated_parser (Parser //time.Time) - (<| (<text>.embed //time.parser) + (<| (<text>.then //time.parser) (..text ..<last_updated>))) (def: #export parser diff --git a/stdlib/source/program/aedifex/command/build.lux b/stdlib/source/program/aedifex/command/build.lux index b5df31411..6a0b6bcd0 100644 --- a/stdlib/source/program/aedifex/command/build.lux +++ b/stdlib/source/program/aedifex/command/build.lux @@ -104,10 +104,10 @@ [#Ruby ..ruby_compiler_name]) _ - (exception.throw ..no_available_compiler [])) + (exception.except ..no_available_compiler [])) _ - (exception.throw ..no_available_compiler [])))) + (exception.except ..no_available_compiler [])))) (def: (path fs home dependency) (All [!] (-> (file.System !) Path Dependency Path)) @@ -266,7 +266,7 @@ (let [target (get@ #///.target profile)] (case (get@ #///.program profile) #.None - (async\wrap (exception.throw ..no_specified_program [])) + (async\in (exception.except ..no_specified_program [])) (#.Some program_module) (do async.monad @@ -274,7 +274,7 @@ #let [home (\ program home) working_directory (\ program directory)]] (do ///action.monad - [[resolution compiler] (async\wrap (..compiler resolution (get@ #///.compiler profile))) + [[resolution compiler] (async\in (..compiler resolution (get@ #///.compiler profile))) #let [host_dependencies (..host_dependencies fs home resolution) [[command compiler_params] output] (case compiler (#JVM dependency) @@ -313,6 +313,6 @@ ..success ..failure) console)] - (wrap [exit - compiler - (format cache_directory / output)]))))))) + (in [exit + compiler + (format cache_directory / output)]))))))) diff --git a/stdlib/source/program/aedifex/command/clean.lux b/stdlib/source/program/aedifex/command/clean.lux index 2ff701d2b..c7443beb6 100644 --- a/stdlib/source/program/aedifex/command/clean.lux +++ b/stdlib/source/program/aedifex/command/clean.lux @@ -45,5 +45,5 @@ (\ ! map (monad.map ! recur)) (\ ! join))] (\ fs delete root))) - (\ ! wrap [])))] + (\ ! in [])))] (console.write_line (..success target) console))) diff --git a/stdlib/source/program/aedifex/command/deploy.lux b/stdlib/source/program/aedifex/command/deploy.lux index 79f6e4f2f..9e74a53a5 100644 --- a/stdlib/source/program/aedifex/command/deploy.lux +++ b/stdlib/source/program/aedifex/command/deploy.lux @@ -64,7 +64,7 @@ set.to_list (export.library fs) (\ ! map (binary.run tar.writer))) - pom (\ async.monad wrap (///pom.write profile)) + pom (\ async.monad in (///pom.write profile)) _ (///dependency/deployment.one repository [artifact ///artifact/type.lux_library] diff --git a/stdlib/source/program/aedifex/command/deps.lux b/stdlib/source/program/aedifex/command/deps.lux index 7e0d655e9..434bedbdd 100644 --- a/stdlib/source/program/aedifex/command/deps.lux +++ b/stdlib/source/program/aedifex/command/deps.lux @@ -74,4 +74,4 @@ (list.sort (\ ///dependency.order <)) (exception.enumerate ..format))]) console)] - (wrap resolution)))) + (in resolution)))) diff --git a/stdlib/source/program/aedifex/command/install.lux b/stdlib/source/program/aedifex/command/install.lux index 142829a8c..ddc73ca36 100644 --- a/stdlib/source/program/aedifex/command/install.lux +++ b/stdlib/source/program/aedifex/command/install.lux @@ -60,7 +60,7 @@ (export.library fs)) pom (|> profile ///pom.write - (\ async.monad wrap)) + (\ async.monad in)) _ (///dependency/deployment.one repository [identity ///artifact/type.lux_library] (let [pom_data (|> pom diff --git a/stdlib/source/program/aedifex/command/pom.lux b/stdlib/source/program/aedifex/command/pom.lux index 73e10f0fc..3b6412070 100644 --- a/stdlib/source/program/aedifex/command/pom.lux +++ b/stdlib/source/program/aedifex/command/pom.lux @@ -31,6 +31,6 @@ [content (|> (///pom.write profile) (try\map (|>> (\ xml.codec encode) (\ utf8.codec encode))) - async\wrap) + async\in) _ (\ fs write content ///pom.file)] (console.write_line ..success console))) diff --git a/stdlib/source/program/aedifex/command/test.lux b/stdlib/source/program/aedifex/command/test.lux index e159a48f2..7af6a4351 100644 --- a/stdlib/source/program/aedifex/command/test.lux +++ b/stdlib/source/program/aedifex/command/test.lux @@ -67,5 +67,5 @@ ..success ..failure) console)] - (wrap [exit []])) - (wrap [build_exit []]))))) + (in [exit []])) + (in [build_exit []]))))) diff --git a/stdlib/source/program/aedifex/dependency/deployment.lux b/stdlib/source/program/aedifex/dependency/deployment.lux index 3a7cba41f..a6302d5f0 100644 --- a/stdlib/source/program/aedifex/dependency/deployment.lux +++ b/stdlib/source/program/aedifex/dependency/deployment.lux @@ -54,7 +54,7 @@ [_ (\ repository upload artifact data)] (case status #///dependency/status.Unverified - (wrap []) + (in []) (#///dependency/status.Partial partial) (case partial @@ -103,17 +103,17 @@ (#///artifact/snapshot.Remote [now (inc build)])))) (set@ [#///metadata/snapshot.versioning #///artifact/versioning.last_updated] now)) versioning_snapshot (get@ [#///metadata/snapshot.versioning #///artifact/versioning.snapshot] snapshot)]] - (wrap (|> snapshot - (set@ [#///metadata/snapshot.versioning #///artifact/versioning.versions] - (list {#///artifact/snapshot/version.extension type - #///artifact/snapshot/version.value (///artifact/snapshot/version/value.format - {#///artifact/snapshot/version/value.version version_template - #///artifact/snapshot/version/value.snapshot versioning_snapshot}) - #///artifact/snapshot/version.updated now})) - ## (set@ [#///metadata/snapshot.versioning #///artifact/versioning.snapshot] - ## (list\compose (..artifacts type (product.right (get@ #///package.library package))) - ## (..artifacts ///artifact/type.pom (product.right (get@ #///package.pom package))))) - )))) + (in (|> snapshot + (set@ [#///metadata/snapshot.versioning #///artifact/versioning.versions] + (list {#///artifact/snapshot/version.extension type + #///artifact/snapshot/version.value (///artifact/snapshot/version/value.format + {#///artifact/snapshot/version/value.version version_template + #///artifact/snapshot/version/value.snapshot versioning_snapshot}) + #///artifact/snapshot/version.updated now})) + ## (set@ [#///metadata/snapshot.versioning #///artifact/versioning.snapshot] + ## (list\compose (..artifacts type (product.right (get@ #///package.library package))) + ## (..artifacts ///artifact/type.pom (product.right (get@ #///package.pom package))))) + )))) (def: #export (one repository [artifact type] package) (-> (Repository Async) Dependency Package (Async (Try Artifact))) @@ -131,14 +131,14 @@ status])) snapshot (///metadata/snapshot.read repository artifact) - snapshot (\ ! wrap (..update_snapshot [artifact type] now snapshot)) + snapshot (\ ! in (..update_snapshot [artifact type] now snapshot)) _ (///metadata/snapshot.write repository artifact snapshot) project (///metadata/artifact.read repository artifact) _ (|> project (set@ #///metadata/artifact.versions (list version_template)) (set@ #///metadata/artifact.last_updated now) (///metadata/artifact.write repository artifact))] - (wrap artifact)))) + (in artifact)))) (def: #export (all repository resolution) (-> (Repository Async) Resolution (Async (Try (Set Artifact)))) diff --git a/stdlib/source/program/aedifex/dependency/resolution.lux b/stdlib/source/program/aedifex/dependency/resolution.lux index 1a97dad34..8c7b6ab6a 100644 --- a/stdlib/source/program/aedifex/dependency/resolution.lux +++ b/stdlib/source/program/aedifex/dependency/resolution.lux @@ -82,22 +82,22 @@ [?actual (\ repository download (///repository/remote.uri version_template artifact extension))] (case ?actual (#try.Success actual) - (wrap (do {! try.monad} - [output (\ ! map (|>> (:as java/lang/String) - java/lang/String::trim - (:as Text)) - (\ utf8.codec decode actual)) - actual (|> output - (text.split_all_with " ") - list.head - (maybe.default output) - (\ codec decode)) - _ (exception.assert exception [artifact extension output] - (\ ///hash.equivalence = (hash library) actual))] - (wrap (#.Some actual)))) + (in (do {! try.monad} + [output (\ ! map (|>> (:as java/lang/String) + java/lang/String::trim + (:as Text)) + (\ utf8.codec decode actual)) + actual (|> output + (text.split_all_with " ") + list.head + (maybe.default output) + (\ codec decode)) + _ (exception.assert exception [artifact extension output] + (\ ///hash.equivalence = (hash library) actual))] + (in (#.Some actual)))) (#try.Failure error) - (wrap (#try.Success #.None))))) + (in (#try.Success #.None))))) (def: (hashed repository version_template artifact extension) (-> (Repository Async) Version Artifact Extension (Async (Try [Binary Status]))) @@ -109,18 +109,18 @@ ?md5 (..verified_hash data repository version_template artifact (format extension ///artifact/extension.md5) ///hash.md5 ///hash.md5_codec ..md5_does_not_match)] - (wrap [data (case [?sha-1 ?md5] - [(#.Some sha-1) (#.Some md5)] - (#//status.Verified sha-1 md5) + (in [data (case [?sha-1 ?md5] + [(#.Some sha-1) (#.Some md5)] + (#//status.Verified sha-1 md5) - [(#.Some sha-1) _] - (#//status.Partial (#.Left sha-1)) + [(#.Some sha-1) _] + (#//status.Partial (#.Left sha-1)) - [_ (#.Some md5)] - (#//status.Partial (#.Right md5)) + [_ (#.Some md5)] + (#//status.Partial (#.Right md5)) - [#.None #.None] - #//status.Unverified)]))) + [#.None #.None] + #//status.Unverified)]))) (def: #export (one repository dependency) (-> (Repository Async) Dependency (Async (Try Package))) @@ -134,14 +134,14 @@ artifact (set@ #///artifact.version artifact_version artifact)] [pom_data pom_status] (..hashed repository version_template artifact ///artifact/extension.pom) library_&_status (..hashed repository version_template artifact extension)] - (\ async.monad wrap + (\ async.monad in (do try.monad [pom (\ utf8.codec decode pom_data) pom (\ xml.codec decode pom) profile (<xml>.run ///pom.parser (list pom))] - (wrap {#///package.origin (#///repository/origin.Remote "") - #///package.library library_&_status - #///package.pom [pom pom_data pom_status]})))))) + (in {#///package.origin (#///repository/origin.Remote "") + #///package.library library_&_status + #///package.pom [pom pom_data pom_status]})))))) (type: #export Resolution (Dictionary Dependency Package)) @@ -179,8 +179,8 @@ (case repositories #.Nil (|> dependency - (exception.throw ..cannot_resolve) - (\ async.monad wrap)) + (exception.except ..cannot_resolve) + (\ async.monad in)) (#.Cons repository alternatives) (do {! async.monad} @@ -190,7 +190,7 @@ (#try.Success package) (do ! [_ (..announce_success console repository (get@ #//.artifact dependency))] - (wrap outcome)) + (in outcome)) (#try.Failure error) (do ! @@ -209,7 +209,7 @@ resolution resolution] (case dependencies #.Nil - (\ async.monad wrap + (\ async.monad in [successes failures resolution]) (#.Cons head tail) @@ -223,7 +223,7 @@ _ (do {! async.monad} [?package (case (dictionary.get head resolution) (#.Some package) - (wrap (#try.Success package)) + (in (#try.Success package)) #.None (..any console repositories head))] diff --git a/stdlib/source/program/aedifex/hash.lux b/stdlib/source/program/aedifex/hash.lux index 760c05ce1..4e83b8f07 100644 --- a/stdlib/source/program/aedifex/hash.lux +++ b/stdlib/source/program/aedifex/hash.lux @@ -99,7 +99,7 @@ (-> Binary (Try (Hash <kind>))) (if (n.= <size> (binary.size data)) (#try.Success (:abstraction data)) - (exception.throw <exception> [data])))] + (exception.except <exception> [data])))] [as_sha-1 SHA-1 ..sha-1::size ..not_a_sha-1] [as_md5 MD5 ..md5::size ..not_a_md5] @@ -142,8 +142,8 @@ ([1 binary.write/8] [2 binary.write/16] [4 binary.write/32]) - _ (exception.throw ..not_a_hash [(..encoding_size size) encoded]))))) - (exception.throw ..not_a_hash [(..encoding_size size) encoded])))) + _ (exception.except ..not_a_hash [(..encoding_size size) encoded]))))) + (exception.except ..not_a_hash [(..encoding_size size) encoded])))) (template [<codec> <hash> <nat> <constructor>] [(implementation: #export <codec> diff --git a/stdlib/source/program/aedifex/metadata/artifact.lux b/stdlib/source/program/aedifex/metadata/artifact.lux index 55659f391..777c7df1b 100644 --- a/stdlib/source/program/aedifex/metadata/artifact.lux +++ b/stdlib/source/program/aedifex/metadata/artifact.lux @@ -135,11 +135,11 @@ (def: last_updated_parser (Parser Instant) - (<text>.embed (do <>.monad - [date ..date_parser - time ..time_parser] - (wrap (instant.of_date_time date time))) - (..text ..<last_updated>))) + (<text>.then (do <>.monad + [date ..date_parser + time ..time_parser] + (in (instant.of_date_time date time))) + (..text ..<last_updated>))) (def: #export parser (Parser Metadata) @@ -178,19 +178,19 @@ [project (\ repository download (..uri artifact))] (case project (#try.Success project) - (wrap (|> project - (do> try.monad - [(\ utf8.codec decode)] - [(\ xml.codec decode)] - [list (<xml>.run ..parser)]))) + (in (|> project + (do> try.monad + [(\ utf8.codec decode)] + [(\ xml.codec decode)] + [list (<xml>.run ..parser)]))) (#try.Failure error) - (wrap (#try.Success - (let [(^slots [#///artifact.group #///artifact.name]) artifact] - {#group group - #name name - #versions (list) - #last_updated ..epoch})))))) + (in (#try.Success + (let [(^slots [#///artifact.group #///artifact.name]) artifact] + {#group group + #name name + #versions (list) + #last_updated ..epoch})))))) (def: #export (write repository artifact metadata) (-> (Repository Async) Artifact Metadata (Async (Try Any))) diff --git a/stdlib/source/program/aedifex/metadata/snapshot.lux b/stdlib/source/program/aedifex/metadata/snapshot.lux index 6faab7b3b..c96957740 100644 --- a/stdlib/source/program/aedifex/metadata/snapshot.lux +++ b/stdlib/source/program/aedifex/metadata/snapshot.lux @@ -106,10 +106,10 @@ (<>.default {#///artifact/versioning.snapshot #///artifact/snapshot.Local #///artifact/versioning.last_updated ///artifact/time.epoch #///artifact/versioning.versions (list <default_version>)})))] - (wrap {#artifact {#///artifact.group group - #///artifact.name name - #///artifact.version version} - #versioning versioning})))) + (in {#artifact {#///artifact.group group + #///artifact.name name + #///artifact.version version} + #versioning versioning})))) (def: #export equivalence (Equivalence Metadata) @@ -128,16 +128,16 @@ [project (\ repository download (..uri artifact))] (case project (#try.Success project) - (wrap (|> project - (do> try.monad - [(\ utf8.codec decode)] - [(\ xml.codec decode)] - [list (<xml>.run ..parser)]))) + (in (|> project + (do> try.monad + [(\ utf8.codec decode)] + [(\ xml.codec decode)] + [list (<xml>.run ..parser)]))) (#try.Failure error) - (wrap (#try.Success - {#artifact artifact - #versioning ///artifact/versioning.init}))))) + (in (#try.Success + {#artifact artifact + #versioning ///artifact/versioning.init}))))) (def: #export (write repository artifact metadata) (-> (Repository Async) Artifact Metadata (Async (Try Any))) diff --git a/stdlib/source/program/aedifex/pom.lux b/stdlib/source/program/aedifex/pom.lux index b458c7a21..145d65f6e 100644 --- a/stdlib/source/program/aedifex/pom.lux +++ b/stdlib/source/program/aedifex/pom.lux @@ -152,7 +152,7 @@ ))) _ - (exception.throw /.no_identity []))) + (exception.except /.no_identity []))) (def: property_parser (Parser [Tag Text]) @@ -173,16 +173,16 @@ (do maybe.monad [group (dictionary.get ["" ..group_tag] properties) artifact (dictionary.get ["" ..artifact_tag] properties)] - (wrap {#//dependency.artifact {#//artifact.group group - #//artifact.name artifact - #//artifact.version (|> properties - (dictionary.get ["" ..version_tag]) - (maybe.default "") - (text.replace_all "${project.version}" own_version) - (text.replace_all "${project.parent.version}" parent_version))} - #//dependency.type (|> properties - (dictionary.get ["" "type"]) - (maybe.default //artifact/type.jvm_library))}))))) + (in {#//dependency.artifact {#//artifact.group group + #//artifact.name artifact + #//artifact.version (|> properties + (dictionary.get ["" ..version_tag]) + (maybe.default "") + (text.replace_all "${project.version}" own_version) + (text.replace_all "${project.parent.version}" parent_version))} + #//dependency.type (|> properties + (dictionary.get ["" "type"]) + (maybe.default //artifact/type.jvm_library))}))))) (def: (dependencies_parser own_version parent_version) (-> Text Text (Parser (List Dependency))) @@ -224,8 +224,8 @@ <xml>.somewhere (<>.default (list))) _ (<>.some <xml>.ignore)] - (wrap (|> (\ /.monoid identity) - (update@ #/.dependencies (function (_ empty) - (list\fold set.add empty dependencies))) - (update@ #/.repositories (function (_ empty) - (list\fold set.add empty repositories))))))))) + (in (|> (\ /.monoid identity) + (update@ #/.dependencies (function (_ empty) + (list\fold set.add empty dependencies))) + (update@ #/.repositories (function (_ empty) + (list\fold set.add empty repositories))))))))) diff --git a/stdlib/source/program/aedifex/project.lux b/stdlib/source/program/aedifex/project.lux index d845ed689..9d3574bd1 100644 --- a/stdlib/source/program/aedifex/project.lux +++ b/stdlib/source/program/aedifex/project.lux @@ -57,19 +57,19 @@ (case (list.find (set.member? lineage) (get@ #//.parents profile)) (#.Some ouroboros) - (exception.throw ..circular_dependency [ouroboros name]) + (exception.except ..circular_dependency [ouroboros name]) #.None (do {! try.monad} [parents (monad.map ! (profile' (set.add name lineage) project) (get@ #//.parents profile))] - (wrap (list\fold (function (_ parent child) - (\ //.monoid compose child parent)) - (set@ #//.parents (list) profile) - parents)))) + (in (list\fold (function (_ parent child) + (\ //.monoid compose child parent)) + (set@ #//.parents (list) profile) + parents)))) #.None - (exception.throw ..unknown_profile [name]))) + (exception.except ..unknown_profile [name]))) (def: #export (profile name project) (-> Name Project (Try Profile)) diff --git a/stdlib/source/program/aedifex/repository.lux b/stdlib/source/program/aedifex/repository.lux index 8f92be270..1ab1e0602 100644 --- a/stdlib/source/program/aedifex/repository.lux +++ b/stdlib/source/program/aedifex/repository.lux @@ -58,10 +58,10 @@ (#try.Success [|state| output]) (do ! [_ (stm.write |state| state)] - (wrap (#try.Success output))) + (in (#try.Success output))) (#try.Failure error) - (wrap (#try.Failure error)))))) + (in (#try.Failure error)))))) (def: (upload uri content) (stm.commit @@ -71,8 +71,8 @@ (#try.Success |state|) (do ! [_ (stm.write |state| state)] - (wrap (#try.Success []))) + (in (#try.Success []))) (#try.Failure error) - (wrap (#try.Failure error)))))) + (in (#try.Failure error)))))) ))) diff --git a/stdlib/source/program/aedifex/repository/local.lux b/stdlib/source/program/aedifex/repository/local.lux index 4620a1363..db9395c09 100644 --- a/stdlib/source/program/aedifex/repository/local.lux +++ b/stdlib/source/program/aedifex/repository/local.lux @@ -51,12 +51,12 @@ [#let [absolute_path (..absolute_path program (\ fs separator) uri)] ? (\ fs file? absolute_path) _ (if ? - (wrap []) + (in []) (case (file.parent fs absolute_path) (#.Some parent) (file.make_directories async.monad fs parent) _ (let [! (try.with async.monad)] - (\ ! wrap []))))] + (\ ! in []))))] (\ fs write content absolute_path)))) diff --git a/stdlib/source/program/aedifex/repository/remote.lux b/stdlib/source/program/aedifex/repository/remote.lux index 118085389..76363c94f 100644 --- a/stdlib/source/program/aedifex/repository/remote.lux +++ b/stdlib/source/program/aedifex/repository/remote.lux @@ -73,7 +73,7 @@ _ (do ! [_ ((get@ #@http.body message) (#.Some 0))] - (\ io.monad wrap (exception.throw ..download_failure [(format address uri) status])))))) + (\ io.monad in (exception.except ..download_failure [(format address uri) status])))))) (def: (upload uri content) (do (try.with io.monad) @@ -91,8 +91,8 @@ _ ((get@ #@http.body message) (#.Some 0))] (case status (^ (static http/status.created)) - (wrap []) + (in []) _ - (\ io.monad wrap (exception.throw ..upload_failure [(format address uri) status]))))) + (\ io.monad in (exception.except ..upload_failure [(format address uri) status]))))) ) diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux index 8d9874216..c804d86b0 100644 --- a/stdlib/source/program/compositor.lux +++ b/stdlib/source/program/compositor.lux @@ -70,7 +70,7 @@ (io.run (\ world/program.default exit +1))) (#try.Success output) - (wrap output)))) + (in output)))) (def: (timed process) (All [a] @@ -82,7 +82,7 @@ (instant.span start) %.duration (format "Duration: ")))]] - (wrap output))) + (in output))) (def: (package! fs host_dependencies [packager package] static archive context) (-> (file.System Async) (Dictionary file.Path Binary) [Packager file.Path] Static Archive Context (Async (Try Any))) @@ -91,7 +91,7 @@ (\ fs write content package) (#try.Failure error) - (\ async.monad wrap (#try.Failure error)))) + (\ async.monad in (#try.Failure error)))) (def: (load_host_dependencies fs host_dependencies) (-> (file.System Async) (List file.Path) (Async (Try (Dictionary file.Path Binary)))) @@ -102,7 +102,7 @@ (dictionary.new text.hash))] (case pending #.Nil - (wrap output) + (in output) (#.Cons head tail) (do ! @@ -152,7 +152,7 @@ (Async (Try [Archive (directive.State+ <parameters>)])) (:assume (platform.compile import static expander platform compilation [archive state]))) _ (ioW.freeze (get@ #platform.&file_system platform) static archive) - program_context (async\wrap ($/program.context archive)) + program_context (async\in ($/program.context archive)) host_dependencies (..load_host_dependencies (get@ #platform.&file_system platform) compilation_host_dependencies) _ (..package! (for {@.old (file.async file.default) @.jvm (file.async file.default) @@ -162,14 +162,14 @@ static archive program_context)] - (wrap (debug.log! "Compilation complete!")))) + (in (debug.log! "Compilation complete!")))) (#/cli.Export export) (<| (or_crash! "Export failed:") (do (try.with async.monad) [_ (/export.export (get@ #platform.&file_system platform) export)] - (wrap (debug.log! "Export complete!")))) + (in (debug.log! "Export complete!")))) (#/cli.Interpretation interpretation) ## TODO: Fix the interpreter... diff --git a/stdlib/source/program/compositor/export.lux b/stdlib/source/program/compositor/export.lux index f17feaf22..46cf9c8ec 100644 --- a/stdlib/source/program/compositor/export.lux +++ b/stdlib/source/program/compositor/export.lux @@ -51,16 +51,16 @@ (text.replace_all (\ fs separator) .module_separator) tar.path) source_code (tar.content source_code)] - (wrap (#tar.Normal [path - (instant.of_millis +0) - ($_ tar.and - tar.read_by_owner tar.write_by_owner - tar.read_by_group tar.write_by_group - tar.read_by_other) - ..no_ownership - source_code]))))) + (in (#tar.Normal [path + (instant.of_millis +0) + ($_ tar.and + tar.read_by_owner tar.write_by_owner + tar.read_by_group tar.write_by_group + tar.read_by_other) + ..no_ownership + source_code]))))) (\ try.monad map row.of_list) - (\ async.monad wrap)))) + (\ async.monad in)))) (def: #export (export fs [sources target]) (-> (file.System Async) Export (Async (Try Any))) diff --git a/stdlib/source/program/compositor/import.lux b/stdlib/source/program/compositor/import.lux index db46d6c13..1e9145bdb 100644 --- a/stdlib/source/program/compositor/import.lux +++ b/stdlib/source/program/compositor/import.lux @@ -57,13 +57,13 @@ (let [path (tar.from_path path)] (case (dictionary.try_put path (tar.data content) import) (#try.Failure error) - (exception.throw ..duplicate [library path]) + (exception.except ..duplicate [library path]) import' import')) _ - (exception.throw ..useless_tar_entry []))) + (exception.except ..useless_tar_entry []))) import))) (\ ! join))))))) diff --git a/stdlib/source/program/scriptum.lux b/stdlib/source/program/scriptum.lux index 5d3117062..889ba4a0f 100644 --- a/stdlib/source/program/scriptum.lux +++ b/stdlib/source/program/scriptum.lux @@ -365,17 +365,17 @@ _ (format "(" (text.join_with " " (list& _name type_arguments)) ")")) nesting (list.size type_arguments)]] - (wrap (md.code (format (if signature? "(interface: " "(type: ") - (if recursive_type? "#rec " "") - usage text.new_line - (|> type - (unravel_type_func nesting) - (when> [(new> recursive_type? [])] [unrecurse_type]) - (pprint_type_definition (dec nesting) [_name type_arguments] (maybe.default (list) tags) module signature? recursive_type?) - (text.split_all_with text.new_line) - (list\map (|>> (format " "))) - (text.join_with text.new_line)) - ")")))) + (in (md.code (format (if signature? "(interface: " "(type: ") + (if recursive_type? "#rec " "") + usage text.new_line + (|> type + (unravel_type_func nesting) + (when> [(new> recursive_type? [])] [unrecurse_type]) + (pprint_type_definition (dec nesting) [_name type_arguments] (maybe.default (list) tags) module signature? recursive_type?) + (text.split_all_with text.new_line) + (list\map (|>> (format " "))) + (text.join_with text.new_line)) + ")")))) _ (meta.failure (exception.construct anonymous_type_definition type)))) @@ -389,19 +389,19 @@ (do meta.monad [#let [?doc (annotation.documentation def_annotations)] type_code (document_type module type def_annotations)] - (wrap ($_ md.then - (md.heading/3 name) - (case ?doc - (#.Some doc) - (md.paragraph (md.text doc)) - - _ - md.empty) - type_code))))) + (in ($_ md.then + (md.heading/3 name) + (case ?doc + (#.Some doc) + (md.paragraph (md.text doc)) + + _ + md.empty) + type_code))))) types)] - (wrap (list\fold (function.flip md.then) - (md.heading/2 "Types") - type_docs)))) + (in (list\fold (function.flip md.then) + (md.heading/2 "Types") + type_docs)))) (def: (document_macros module_name names) (-> Text (List [Text Code]) (Markdown Block)) @@ -414,7 +414,7 @@ (maybe.default md.empty) (do maybe.monad [documentation (annotation.documentation def_annotations)] - (wrap (md.code documentation)))))))) + (in (md.code documentation)))))))) (list\fold (function.flip md.then) (md.heading/2 "Macros")))) @@ -473,18 +473,18 @@ md.empty) empty_block (: (Markdown Block) md.empty)] types_documentation (if (list.empty? types) - (wrap empty_block) + (in empty_block) (document_types module_name types)) #let [documentation ($_ md.then types_documentation (if (list.empty? macros) empty_block (document_macros module_name macros)) (if (list.empty? implementations) empty_block (document_implementations module_name implementations)) (if (list.empty? values) empty_block (document_values module_name values)))]] - (wrap [module_name - ($_ md.then - (md.heading/1 module_name) - description - documentation)]))) + (in [module_name + ($_ md.then + (md.heading/1 module_name) + description + documentation)]))) (exception: #export (io_error {error Text}) error) @@ -494,12 +494,12 @@ (let [path (format (text.replace_all "/" "_" module_name) ".md")] (do io.monad [outcome (\ file.default write (\ utf8.codec encode (md.markdown documentation)) path)] - (wrap (case outcome - (#try.Failure error) - (debug.log! (exception.construct io_error error)) + (in (case outcome + (#try.Failure error) + (debug.log! (exception.construct io_error error)) - (#try.Success _) - []))))) + (#try.Success _) + []))))) (macro: (gen_documentation! _) (do {! meta.monad} @@ -513,7 +513,7 @@ (list.zipped/2 lux_modules) (monad.map ! document_module)) #let [_ (io.run (monad.map io.monad save_documentation! module_documentation))]] - (wrap (list)))) + (in (list)))) (gen_documentation!) diff --git a/stdlib/source/specification/aedifex/repository.lux b/stdlib/source/specification/aedifex/repository.lux index 8a2965d51..1b16d774d 100644 --- a/stdlib/source/specification/aedifex/repository.lux +++ b/stdlib/source/specification/aedifex/repository.lux @@ -27,31 +27,31 @@ (-> Artifact Artifact (/.Repository Async) Test) (do random.monad [expected (_binary.random 100)] - (wrap ($_ _.and' - (do async.monad - [#let [good_uri (/remote.uri (get@ #//artifact.version valid_artifact) valid_artifact //artifact/extension.lux_library)] - good_upload! (\ subject upload good_uri expected) - good_download! (\ subject download good_uri) + (in ($_ _.and' + (do async.monad + [#let [good_uri (/remote.uri (get@ #//artifact.version valid_artifact) valid_artifact //artifact/extension.lux_library)] + good_upload! (\ subject upload good_uri expected) + good_download! (\ subject download good_uri) - #let [bad_uri (/remote.uri (get@ #//artifact.version invalid_artifact) invalid_artifact //artifact/extension.lux_library)] - bad_upload! (\ subject upload bad_uri expected) - bad_download! (\ subject download bad_uri)] - (_.cover' [/.Repository] - (let [successfull_flow! - (case [good_upload! good_download!] - [(#try.Success _) (#try.Success actual)] - (\ binary.equivalence = expected actual) + #let [bad_uri (/remote.uri (get@ #//artifact.version invalid_artifact) invalid_artifact //artifact/extension.lux_library)] + bad_upload! (\ subject upload bad_uri expected) + bad_download! (\ subject download bad_uri)] + (_.cover' [/.Repository] + (let [successfull_flow! + (case [good_upload! good_download!] + [(#try.Success _) (#try.Success actual)] + (\ binary.equivalence = expected actual) - _ - false) + _ + false) - failed_flow! - (case [bad_upload! bad_download!] - [(#try.Failure _) (#try.Failure _)] - true + failed_flow! + (case [bad_upload! bad_download!] + [(#try.Failure _) (#try.Failure _)] + true - _ - false)] - (and successfull_flow! - failed_flow!)))) - )))) + _ + false)] + (and successfull_flow! + failed_flow!)))) + )))) diff --git a/stdlib/source/specification/compositor.lux b/stdlib/source/specification/compositor.lux index 8ccf1e02f..162dcbec8 100644 --- a/stdlib/source/specification/compositor.lux +++ b/stdlib/source/specification/compositor.lux @@ -49,7 +49,7 @@ (-> expression directive) Test)) (do r.monad - [_ (wrap []) + [_ (in []) #let [?state,runner,definer (<| io.run (do io.monad [platform platform]) diff --git a/stdlib/source/specification/compositor/analysis/type.lux b/stdlib/source/specification/compositor/analysis/type.lux index 7cbd5884b..4db867513 100644 --- a/stdlib/source/specification/compositor/analysis/type.lux +++ b/stdlib/source/specification/compositor/analysis/type.lux @@ -23,8 +23,8 @@ (def: (check-success+ expander state extension params output-type) (-> Expander State+ Text (List Code) Type Bit) (|> (analysis/scope.with-scope "" - (analysis/type.with-type output-type - (analysis.phase expander (` ((~ (code.text extension)) (~+ params)))))) + (analysis/type.with-type output-type + (analysis.phase expander (` ((~ (code.text extension)) (~+ params)))))) (phase.run state) (case> (#try.Success _) true @@ -38,9 +38,9 @@ (~~ (template [<random> <type> <code>] [(do r.monad [value <random>] - (wrap [(` <type>) - <type> - (<code> value)]))] + (in [(` <type>) + <type> + (<code> value)]))] [r.bit (0 #0 "#Bit" (0 #0)) code.bit] [r.nat (0 #0 "#I64" (0 #1 (0 #0 "#Nat" (0 #0)) (0 #0))) code.nat] diff --git a/stdlib/source/specification/compositor/common.lux b/stdlib/source/specification/compositor/common.lux index ed3b53f30..33268ecde 100644 --- a/stdlib/source/specification/compositor/common.lux +++ b/stdlib/source/specification/compositor/common.lux @@ -71,11 +71,11 @@ Definer])))) (do io.monad [?state (platform.initialize target expander analysis-bundle platform generation-bundle directive-bundle program extender)] - (wrap (do try.monad - [[directive-bundle directive-state] ?state - #let [generation-state (get@ [#directive.generation - #directive.state] - directive-state)]] - (wrap [[directive-bundle directive-state] - (..runner platform generation-state) - (..definer platform generation-state)]))))) + (in (do try.monad + [[directive-bundle directive-state] ?state + #let [generation-state (get@ [#directive.generation + #directive.state] + directive-state)]] + (in [[directive-bundle directive-state] + (..runner platform generation-state) + (..definer platform generation-state)]))))) diff --git a/stdlib/source/specification/compositor/generation/case.lux b/stdlib/source/specification/compositor/generation/case.lux index 81e6f5988..d18d6b461 100644 --- a/stdlib/source/specification/compositor/generation/case.lux +++ b/stdlib/source/specification/compositor/generation/case.lux @@ -52,13 +52,13 @@ (`` ($_ r.either (do r.monad [value r.i64] - (wrap [(synthesis.i64 value) - synthesis.path/pop])) + (in [(synthesis.i64 value) + synthesis.path/pop])) (~~ (template [<gen> <synth> <path>] [(do r.monad [value <gen>] - (wrap [(<synth> value) - (<path> value)]))] + (in [(<synth> value) + (<path> value)]))] [r.bit synthesis.bit synthesis.path/bit] [r.i64 synthesis.i64 synthesis.path/i64] @@ -78,7 +78,7 @@ (synthesis.member/right idx) (synthesis.member/left idx)) subP)]] - (wrap [caseS caseP])) + (in [caseS caseP])) (do {! r.monad} [size ..size idx (|> r.nat (\ ! map (n.% size))) @@ -93,7 +93,7 @@ (synthesis.side/right idx) (synthesis.side/left idx)) subP)]] - (wrap [caseS caseP])) + (in [caseS caseP])) )))) (def: (let-spec run) diff --git a/stdlib/source/specification/compositor/generation/function.lux b/stdlib/source/specification/compositor/generation/function.lux index 6d0f8d541..61f6d6656 100644 --- a/stdlib/source/specification/compositor/generation/function.lux +++ b/stdlib/source/specification/compositor/generation/function.lux @@ -24,7 +24,9 @@ [// [common (#+ Runner)]]]) -(def: max-arity Arity 10) +(def: max-arity + Arity + 10) (def: arity (Random Arity) @@ -39,11 +41,11 @@ (do r.monad [arity ..arity local (..local arity)] - (wrap [arity local - (synthesis.function/abstraction - {#synthesis.environment (list) - #synthesis.arity arity - #synthesis.body (synthesis.variable/local local)})]))) + (in [arity local + (synthesis.function/abstraction + {#synthesis.environment (list) + #synthesis.arity arity + #synthesis.body (synthesis.variable/local local)})]))) (def: #export (spec run) (-> Runner Test) diff --git a/stdlib/source/specification/lux/abstract/comonad.lux b/stdlib/source/specification/lux/abstract/comonad.lux index d4532a70b..8b45adb88 100644 --- a/stdlib/source/specification/lux/abstract/comonad.lux +++ b/stdlib/source/specification/lux/abstract/comonad.lux @@ -18,12 +18,12 @@ (do {! random.monad} [sample random.nat morphism (\ ! map (function (_ diff) - (|>> _//unwrap (n.+ diff))) + (|>> _//out (n.+ diff))) random.nat) #let [start (injection sample)]] (_.test "Left identity." (n.= (morphism start) - (|> start _//split (_//map morphism) _//unwrap))))) + (|> start _//split (_//map morphism) _//out))))) (def: (right_identity injection comparison (^open "_//.")) (All [f] (-> (Injection f) (Comparison f) (CoMonad f) Test)) @@ -33,17 +33,17 @@ == (comparison n.=)]] (_.test "Right identity." (== start - (|> start _//split (_//map _//unwrap)))))) + (|> start _//split (_//map _//out)))))) (def: (associativity injection comparison (^open "_//.")) (All [f] (-> (Injection f) (Comparison f) (CoMonad f) Test)) (do {! random.monad} [sample random.nat increase (\ ! map (function (_ diff) - (|>> _//unwrap (n.+ diff))) + (|>> _//out (n.+ diff))) random.nat) decrease (\ ! map (function (_ diff) - (|>> _//unwrap(n.- diff))) + (|>> _//out(n.- diff))) random.nat) #let [start (injection sample) == (comparison n.=)]] diff --git a/stdlib/source/specification/lux/abstract/monad.lux b/stdlib/source/specification/lux/abstract/monad.lux index bc1b643f2..1a602b292 100644 --- a/stdlib/source/specification/lux/abstract/monad.lux +++ b/stdlib/source/specification/lux/abstract/monad.lux @@ -16,7 +16,7 @@ (do {! random.monad} [sample random.nat morphism (\ ! map (function (_ diff) - (|>> (n.+ diff) _//wrap)) + (|>> (n.+ diff) _//in)) random.nat)] (_.test "Left identity." ((comparison n.=) @@ -29,7 +29,7 @@ [sample random.nat] (_.test "Right identity." ((comparison n.=) - (|> (injection sample) (_//map _//wrap) _//join) + (|> (injection sample) (_//map _//in) _//join) (injection sample))))) (def: (associativity injection comparison (^open "_//.")) @@ -37,10 +37,10 @@ (do {! random.monad} [sample random.nat increase (\ ! map (function (_ diff) - (|>> (n.+ diff) _//wrap)) + (|>> (n.+ diff) _//in)) random.nat) decrease (\ ! map (function (_ diff) - (|>> (n.- diff) _//wrap)) + (|>> (n.- diff) _//in)) random.nat)] (_.test "Associativity." ((comparison n.=) diff --git a/stdlib/source/specification/lux/world/console.lux b/stdlib/source/specification/lux/world/console.lux index cd2f88485..5632e5cd8 100644 --- a/stdlib/source/specification/lux/world/console.lux +++ b/stdlib/source/specification/lux/world/console.lux @@ -21,38 +21,38 @@ (-> (IO (/.Console Async)) Test) (do random.monad [message (random.ascii/alpha 10)] - (wrap (do async.monad - [console (async.future console) - ?write (\ console write (format message text.new_line)) - ?read (\ console read []) - ?read_line (\ console read_line []) - ?close/good (\ console close []) - ?close/bad (\ console close []) + (in (do async.monad + [console (async.future console) + ?write (\ console write (format message text.new_line)) + ?read (\ console read []) + ?read_line (\ console read_line []) + ?close/good (\ console close []) + ?close/bad (\ console close []) - #let [can_write! - (case ?write - (#try.Success _) - true - - _ - false) + #let [can_write! + (case ?write + (#try.Success _) + true + + _ + false) - can_read! - (case [?read ?read_line] - [(#try.Success _) (#try.Success _)] - true + can_read! + (case [?read ?read_line] + [(#try.Success _) (#try.Success _)] + true - _ - false) + _ + false) - can_close! - (case [?close/good ?close/bad] - [(#try.Success _) (#try.Failure _)] - true - - _ - false)]] - (_.cover' [/.Console] - (and can_write! - can_read! - can_close!)))))) + can_close! + (case [?close/good ?close/bad] + [(#try.Success _) (#try.Failure _)] + true + + _ + false)]] + (_.cover' [/.Console] + (and can_write! + can_read! + can_close!)))))) diff --git a/stdlib/source/specification/lux/world/file.lux b/stdlib/source/specification/lux/world/file.lux index fd1585c34..910dfde68 100644 --- a/stdlib/source/specification/lux/world/file.lux +++ b/stdlib/source/specification/lux/world/file.lux @@ -37,7 +37,7 @@ (do {! random.monad} [parent (random.ascii/numeric 2) child (random.ascii/numeric 2)]) - wrap + in (do async.monad [fs (async.future fs)] ($_ _.and' @@ -80,11 +80,11 @@ [directory_pre! (\ fs directory? parent) made? (\ fs make_directory parent) directory_post! (\ fs directory? parent)] - (wrap (and (not directory_pre!) - (case made? - (#try.Success _) true - (#try.Failure _) false) - directory_post!)))) + (in (and (not directory_pre!) + (case made? + (#try.Success _) true + (#try.Failure _) false) + directory_post!)))) (def: (file?&write fs content path) (-> (/.System Async) Binary /.Path (Async Bit)) @@ -92,11 +92,11 @@ [file_pre! (\ fs file? path) made? (\ fs write content path) file_post! (\ fs file? path)] - (wrap (and (not file_pre!) - (case made? - (#try.Success _) true - (#try.Failure _) false) - file_post!)))) + (in (and (not file_pre!) + (case made? + (#try.Success _) true + (#try.Failure _) false) + file_post!)))) (def: (file_size&read&append fs expected_file_size content appendix path) (-> (/.System Async) Nat Binary Binary /.Path (Async Bit)) @@ -106,35 +106,35 @@ appended? (\ fs append appendix path) post_file_size (\ fs file_size path) post_content (\ fs read path)] - (wrap (<| (try.default false) - (do {! try.monad} - [pre_file_size! - (\ ! map (n.= expected_file_size) pre_file_size) - - pre_content! - (\ ! map (binary\= content) pre_content) - - _ appended? + (in (<| (try.default false) + (do {! try.monad} + [pre_file_size! + (\ ! map (n.= expected_file_size) pre_file_size) + + pre_content! + (\ ! map (binary\= content) pre_content) + + _ appended? - post_file_size! - (\ ! map (n.= (n.* 2 expected_file_size)) post_file_size) - - post_content! - (\ ! map (binary\= (binary\compose content appendix)) post_content)] - (wrap (and pre_file_size! - pre_content! - post_file_size! - post_content!))))))) + post_file_size! + (\ ! map (n.= (n.* 2 expected_file_size)) post_file_size) + + post_content! + (\ ! map (binary\= (binary\compose content appendix)) post_content)] + (in (and pre_file_size! + pre_content! + post_file_size! + post_content!))))))) (def: (modified?&last_modified fs expected_time path) (-> (/.System Async) Instant /.Path (Async Bit)) (do async.monad [modified? (\ fs modify expected_time path) last_modified (\ fs last_modified path)] - (wrap (<| (try.default false) - (do {! try.monad} - [_ modified?] - (\ ! map (instant\= expected_time) last_modified)))))) + (in (<| (try.default false) + (do {! try.monad} + [_ modified?] + (\ ! map (instant\= expected_time) last_modified)))))) (def: (directory_files&sub_directories fs parent sub_dir child) (-> (/.System Async) /.Path /.Path /.Path (Async Bit)) @@ -145,15 +145,15 @@ directory_files (\ fs directory_files parent) sub_directories (\ fs sub_directories parent) #let [(^open "list\.") (list.equivalence text.equivalence)]] - (wrap (<| (try.default false) - (do try.monad - [_ made_sub?] - (wrap (and (|> directory_files - (try\map (list\= (list child))) - (try.default false)) - (|> sub_directories - (try\map (list\= (list sub_dir))) - (try.default false)))))))))) + (in (<| (try.default false) + (do try.monad + [_ made_sub?] + (in (and (|> directory_files + (try\map (list\= (list child))) + (try.default false)) + (|> sub_directories + (try\map (list\= (list sub_dir))) + (try.default false)))))))))) (def: (move&delete fs parent child alternate_child) (-> (/.System Async) /.Path Text Text (Async Bit)) @@ -166,12 +166,12 @@ (\ ! map not)) found? (\ fs file? destination) deleted? (\ fs delete destination)] - (wrap (<| (try.default false) - (do try.monad - [_ moved? - _ deleted?] - (wrap (and lost? - found?)))))))) + (in (<| (try.default false) + (do try.monad + [_ moved? + _ deleted?] + (in (and lost? + found?)))))))) (def: (for_system fs) (-> (IO (/.System Async)) Test) @@ -180,7 +180,7 @@ child (random.ascii/numeric 2) sub_dir (random.only (|>> (text\= child) not) (random.ascii/numeric 2)) - alternate_child (random.only (predicate.intersect + alternate_child (random.only (predicate.and (|>> (text\= child) not) (|>> (text\= sub_dir) not)) (random.ascii/numeric 2)) @@ -188,7 +188,7 @@ content ($binary.random expected_file_size) appendix ($binary.random expected_file_size) expected_time random.instant]) - wrap + in (do {! async.monad} [fs (async.future fs) #let [path (/.nest fs parent child)] @@ -230,7 +230,7 @@ [dir/0 (random.ascii/numeric 2) dir/1 (random.ascii/numeric 2) dir/2 (random.ascii/numeric 2)]) - wrap + in (do {! async.monad} [fs (async.future fs) #let [dir/1 (/.nest fs dir/0 dir/1) @@ -275,7 +275,7 @@ (-> (IO (/.System Async)) Test) (<| (do {! random.monad} [file/0 (random.ascii/numeric 3)]) - wrap + in (do {! async.monad} [fs (async.future fs) make_file!/0 (/.make_file ! fs (utf8\encode file/0) file/0) @@ -307,7 +307,7 @@ [file (random.ascii/numeric 2) dir (random.only (|>> (text\= file) not) (random.ascii/numeric 2))]) - wrap + in (do {! async.monad} [fs (async.future fs) diff --git a/stdlib/source/specification/lux/world/program.lux b/stdlib/source/specification/lux/world/program.lux index 411f29fe9..091f41c2c 100644 --- a/stdlib/source/specification/lux/world/program.lux +++ b/stdlib/source/specification/lux/world/program.lux @@ -22,11 +22,11 @@ (-> (/.Program Async) Test) (do random.monad [exit random.int] - (wrap (do {! async.monad} - [environment (/.environment ! subject)] - (_.cover' [/.Program] - (and (not (dictionary.empty? environment)) - (list.every? (|>> text.empty? not) - (dictionary.keys environment)) - (not (text.empty? (\ subject home))) - (not (text.empty? (\ subject directory))))))))) + (in (do {! async.monad} + [environment (/.environment ! subject)] + (_.cover' [/.Program] + (and (not (dictionary.empty? environment)) + (list.every? (|>> text.empty? not) + (dictionary.keys environment)) + (not (text.empty? (\ subject home))) + (not (text.empty? (\ subject directory))))))))) diff --git a/stdlib/source/specification/lux/world/shell.lux b/stdlib/source/specification/lux/world/shell.lux index 55197a307..f7d8f28e7 100644 --- a/stdlib/source/specification/lux/world/shell.lux +++ b/stdlib/source/specification/lux/world/shell.lux @@ -52,18 +52,18 @@ (do async.monad [?destroy (\ process destroy []) ?await (\ process await [])] - (wrap (and (case ?destroy - (#try.Success _) - true - - (#try.Failure error) - false) - (case ?await - (#try.Success _) - false - - (#try.Failure error) - true))))) + (in (and (case ?destroy + (#try.Success _) + true + + (#try.Failure error) + false) + (case ?await + (#try.Success _) + false + + (#try.Failure error) + true))))) (with_expansions [<shell_coverage> (as_is [/.Command /.Argument])] (def: #export (spec shell) @@ -72,21 +72,21 @@ (do {! random.monad} [message (random.ascii/alpha 10) seconds (\ ! map (|>> (n.% 5) (n.+ 5)) random.nat)] - (wrap (do {! async.monad} - [?echo (\ shell execute (..echo! message)) - ?sleep (\ shell execute (..sleep! seconds))] - (case [?echo ?sleep] - [(#try.Success echo) (#try.Success sleep)] - (do ! - [can_read! (..can_read! message echo) - can_destroy! (..can_destroy! sleep)] - ($_ _.and' - (_.cover' <shell_coverage> - (and can_read! - can_destroy!)) - (..can_wait! echo) - )) - - _ - (_.cover' <shell_coverage> - false)))))))) + (in (do {! async.monad} + [?echo (\ shell execute (..echo! message)) + ?sleep (\ shell execute (..sleep! seconds))] + (case [?echo ?sleep] + [(#try.Success echo) (#try.Success sleep)] + (do ! + [can_read! (..can_read! message echo) + can_destroy! (..can_destroy! sleep)] + ($_ _.and' + (_.cover' <shell_coverage> + (and can_read! + can_destroy!)) + (..can_wait! echo) + )) + + _ + (_.cover' <shell_coverage> + false)))))))) diff --git a/stdlib/source/test/aedifex/artifact/snapshot.lux b/stdlib/source/test/aedifex/artifact/snapshot.lux index 5f29620c9..931fefd17 100644 --- a/stdlib/source/test/aedifex/artifact/snapshot.lux +++ b/stdlib/source/test/aedifex/artifact/snapshot.lux @@ -22,7 +22,7 @@ (def: #export random (Random /.Snapshot) - (random.or (random\wrap []) + (random.or (random\in []) $/stamp.random)) (def: #export test diff --git a/stdlib/source/test/aedifex/artifact/snapshot/version/value.lux b/stdlib/source/test/aedifex/artifact/snapshot/version/value.lux index c55b71cd1..cfd8a7f17 100644 --- a/stdlib/source/test/aedifex/artifact/snapshot/version/value.lux +++ b/stdlib/source/test/aedifex/artifact/snapshot/version/value.lux @@ -32,7 +32,7 @@ (Random /.Value) ($_ random.and (random.ascii/alpha 5) - (random.or (random\wrap []) + (random.or (random\in []) $///stamp.random) )) diff --git a/stdlib/source/test/aedifex/artifact/time.lux b/stdlib/source/test/aedifex/artifact/time.lux index 8873a7f1d..9ac9be6ae 100644 --- a/stdlib/source/test/aedifex/artifact/time.lux +++ b/stdlib/source/test/aedifex/artifact/time.lux @@ -27,7 +27,7 @@ (do random.monad [date /date.random time /time.random] - (wrap [date time]))) + (in [date time]))) (def: #export test Test diff --git a/stdlib/source/test/aedifex/artifact/time/date.lux b/stdlib/source/test/aedifex/artifact/time/date.lux index 35ae3a157..4d44b5358 100644 --- a/stdlib/source/test/aedifex/artifact/time/date.lux +++ b/stdlib/source/test/aedifex/artifact/time/date.lux @@ -25,7 +25,7 @@ (def: #export random (Random /.Date) (random.one (function (_ raw) - (try.to_maybe + (try.maybe (do try.monad [year (|> raw date.year year.value i.abs (i.% +9,000) (i.+ +1,000) year.year) raw (date.date year diff --git a/stdlib/source/test/aedifex/artifact/type.lux b/stdlib/source/test/aedifex/artifact/type.lux index 017e417cb..b34db299c 100644 --- a/stdlib/source/test/aedifex/artifact/type.lux +++ b/stdlib/source/test/aedifex/artifact/type.lux @@ -20,12 +20,12 @@ (Random /.Type) ($_ random.either ($_ random.either - (random\wrap /.lux_library) - (random\wrap /.jvm_library)) + (random\in /.lux_library) + (random\in /.jvm_library)) ($_ random.either - (random\wrap /.pom) - (random\wrap /.md5) - (random\wrap /.sha-1)) + (random\in /.pom) + (random\in /.md5) + (random\in /.sha-1)) )) (def: #export test diff --git a/stdlib/source/test/aedifex/cache.lux b/stdlib/source/test/aedifex/cache.lux index 19fd23203..2a2d3d2e4 100644 --- a/stdlib/source/test/aedifex/cache.lux +++ b/stdlib/source/test/aedifex/cache.lux @@ -48,8 +48,8 @@ (def: type (Random Type) ($_ random.either - (random\wrap //artifact/type.lux_library) - (random\wrap //artifact/type.jvm_library))) + (random\in //artifact/type.lux_library) + (random\in //artifact/type.jvm_library))) (def: profile (Random [Artifact Profile XML]) @@ -58,7 +58,7 @@ (do try.monad [pom (//pom.write profile) identity (try.of_maybe (get@ #//.identity profile))] - (wrap [identity profile pom])))) + (in [identity profile pom])))) @profile.random)) (def: content @@ -73,9 +73,9 @@ [[identity profile pom] ..profile type ..type content ..content] - (wrap [{#//dependency.artifact identity - #//dependency.type type} - (set@ #//package.origin (#//repository/origin.Remote "") (//package.local pom content))]))) + (in [{#//dependency.artifact identity + #//dependency.type type} + (set@ #//package.origin (#//repository/origin.Remote "") (//package.local pom content))]))) (def: resolution (Random Resolution) @@ -94,9 +94,9 @@ try.to_maybe)) ..profile) content ..content] - (wrap [dependency - (set@ #//package.origin (#//repository/origin.Remote "") (//package.local pom content))])))))] - (wrap (dictionary.of_list //dependency.hash (list& [main_dependency main_package] dependencies))))) + (in [dependency + (set@ #//package.origin (#//repository/origin.Remote "") (//package.local pom content))])))))] + (in (dictionary.of_list //dependency.hash (list& [main_dependency main_package] dependencies))))) (def: singular Test @@ -107,17 +107,17 @@ #let [fs (: (file.System Async) (file.mock (\ file.default separator))) program (program.async (program.mock environment.empty home working_directory))]] - (wrap (do async.monad - [wrote! (/.write_one program fs dependency expected_package) - read! (/.read_one program fs dependency)] - (_.cover' [/.write_one /.read_one] - (<| (try.default false) - (do try.monad - [_ wrote! - actual_package read!] - (wrap (\ //package.equivalence = - (set@ #//package.origin (#//repository/origin.Local "") expected_package) - actual_package))))))))) + (in (do async.monad + [wrote! (/.write_one program fs dependency expected_package) + read! (/.read_one program fs dependency)] + (_.cover' [/.write_one /.read_one] + (<| (try.default false) + (do try.monad + [_ wrote! + actual_package read!] + (in (\ //package.equivalence = + (set@ #//package.origin (#//repository/origin.Local "") expected_package) + actual_package))))))))) (def: plural Test @@ -128,19 +128,19 @@ #let [fs (: (file.System Async) (file.mock (\ file.default separator))) program (program.async (program.mock environment.empty home working_directory))]] - (wrap (do async.monad - [wrote! (/.write_all program fs expected) - read! (/.read_all program fs (dictionary.keys expected) //dependency/resolution.empty)] - (_.cover' [/.write_all /.read_all] - (<| (try.default false) - (do try.monad - [_ wrote! - actual read!] - (wrap (\ //dependency/resolution.equivalence = - (\ dictionary.functor map - (set@ #//package.origin (#//repository/origin.Local "")) - expected) - actual))))))))) + (in (do async.monad + [wrote! (/.write_all program fs expected) + read! (/.read_all program fs (dictionary.keys expected) //dependency/resolution.empty)] + (_.cover' [/.write_all /.read_all] + (<| (try.default false) + (do try.monad + [_ wrote! + actual read!] + (in (\ //dependency/resolution.equivalence = + (\ dictionary.functor map + (set@ #//package.origin (#//repository/origin.Local "")) + expected) + actual))))))))) (def: #export test Test diff --git a/stdlib/source/test/aedifex/cli.lux b/stdlib/source/test/aedifex/cli.lux index 6f83f5a11..6c251b0a4 100644 --- a/stdlib/source/test/aedifex/cli.lux +++ b/stdlib/source/test/aedifex/cli.lux @@ -22,22 +22,22 @@ (def: compilation (Random /.Compilation) - (random.or (random\wrap []) - (random\wrap []))) + (random.or (random\in []) + (random\in []))) (def: command (Random /.Command) ($_ random.or ## #Version - (random\wrap []) + (random\in []) ## #Clean - (random\wrap []) + (random\in []) ## #POM - (random\wrap []) + (random\in []) ## #Dependencies - (random\wrap []) + (random\in []) ## #Install - (random\wrap []) + (random\in []) ## #Deploy ($_ random.and (random.ascii/alpha 1) diff --git a/stdlib/source/test/aedifex/command/auto.lux b/stdlib/source/test/aedifex/command/auto.lux index 27b12bc42..e27fd039a 100644 --- a/stdlib/source/test/aedifex/command/auto.lux +++ b/stdlib/source/test/aedifex/command/auto.lux @@ -55,13 +55,13 @@ (do {! async.monad} [[_ actual_runs] (async.future (atom.update inc @runs))] (if (n.= expected_runs actual_runs) - (wrap (#try.Failure end_signal)) + (in (#try.Failure end_signal)) (do (try.with !) [_ (\ fs write (\ utf8.codec encode (%.nat actual_runs)) dummy_file) _ (\ fs modify (|> actual_runs .int instant.of_millis) dummy_file)] - (wrap [shell.normal []])))))])) + (in [shell.normal []])))))])) (def: #export test Test @@ -95,32 +95,32 @@ ($_ _.and (_.cover [/.delay] (n.> 0 /.delay)) - (wrap (do async.monad - [verdict (do ///action.monad - [_ (\ fs make_directory source) - _ (\ fs write (binary.create 0) dummy_path) - #let [[@runs command] (..command expected_runs end_signal fs dummy_path)] - _ (\ watcher poll [])] - (do {! async.monad} - [no_dangling_process! (|> profile - (set@ #///.compiler compiler) - ((/.do! 1 watcher command) - ($version.echo "") - (program.async (program.mock environment.empty home working_directory)) - fs - (shell.async ($build.good_shell [])) - resolution) - (\ ! map (|>> (case> (#try.Failure error) - (is? end_signal error) + (in (do async.monad + [verdict (do ///action.monad + [_ (\ fs make_directory source) + _ (\ fs write (binary.create 0) dummy_path) + #let [[@runs command] (..command expected_runs end_signal fs dummy_path)] + _ (\ watcher poll [])] + (do {! async.monad} + [no_dangling_process! (|> profile + (set@ #///.compiler compiler) + ((/.do! 1 watcher command) + ($version.echo "") + (program.async (program.mock environment.empty home working_directory)) + fs + (shell.async ($build.good_shell [])) + resolution) + (\ ! map (|>> (case> (#try.Failure error) + (is? end_signal error) - (#try.Success _) - false)))) - correct_number_of_runs! (|> @runs - atom.read - async.future - (\ ! map (n.= expected_runs)))] - (wrap (#try.Success (and correct_number_of_runs! - no_dangling_process!)))))] - (_.cover' [/.do!] - (try.default false verdict)))) + (#try.Success _) + false)))) + correct_number_of_runs! (|> @runs + atom.read + async.future + (\ ! map (n.= expected_runs)))] + (in (#try.Success (and correct_number_of_runs! + no_dangling_process!)))))] + (_.cover' [/.do!] + (try.default false verdict)))) )))) diff --git a/stdlib/source/test/aedifex/command/build.lux b/stdlib/source/test/aedifex/command/build.lux index 3bc7f86dc..141573f6f 100644 --- a/stdlib/source/test/aedifex/command/build.lux +++ b/stdlib/source/test/aedifex/command/build.lux @@ -45,9 +45,9 @@ (: (shell.Mock []) (implementation (def: (on_read state) - (exception.throw shell.no_more_output [])) + (exception.except shell.no_more_output [])) (def: (on_error state) - (exception.throw shell.no_more_output [])) + (exception.except shell.no_more_output [])) (def: (on_write input state) (#try.Failure "on_write")) (def: (on_destroy state) @@ -63,9 +63,9 @@ (: (shell.Mock []) (implementation (def: (on_read state) - (exception.throw shell.no_more_output [])) + (exception.except shell.no_more_output [])) (def: (on_error state) - (exception.throw shell.no_more_output [])) + (exception.except shell.no_more_output [])) (def: (on_write input state) (#try.Failure "on_write")) (def: (on_destroy state) @@ -82,13 +82,13 @@ (implementation (def: (on_read state) (if error? - (exception.throw shell.no_more_output []) + (exception.except shell.no_more_output []) (case state (#.Cons head tail) (#try.Success [tail head]) #.Nil - (exception.throw shell.no_more_output [])))) + (exception.except shell.no_more_output [])))) (def: (on_error state) (if error? (case state @@ -96,8 +96,8 @@ (#try.Success [tail head]) #.Nil - (exception.throw shell.no_more_output [])) - (exception.throw shell.no_more_output []))) + (exception.except shell.no_more_output [])) + (exception.except shell.no_more_output []))) (def: (on_write input state) (#try.Failure "on_write")) (def: (on_destroy state) @@ -114,12 +114,12 @@ #///artifact.version lux_version} #///dependency.type ///artifact/type.js_library}]] (`` ($_ random.either - (wrap js_compiler) + (in js_compiler) (~~ (template [<compiler>] - [(wrap {#///dependency.artifact {#///artifact.group /.lux_group - #///artifact.name <compiler> - #///artifact.version lux_version} - #///dependency.type ///artifact/type.lux_library})] + [(in {#///dependency.artifact {#///artifact.group /.lux_group + #///artifact.name <compiler> + #///artifact.version lux_version} + #///dependency.type ///artifact/type.lux_library})] [/.jvm_compiler_name] [/.python_compiler_name] @@ -132,9 +132,9 @@ (do random.monad [dependency ..compiler [_ package] $///package.random] - (wrap [dependency - (|> ///dependency/resolution.empty - (dictionary.put dependency package))]))) + (in [dependency + (|> ///dependency/resolution.empty + (dictionary.put dependency package))]))) (def: #export test Test @@ -159,61 +159,61 @@ with_program with_target)]] ($_ _.and - (wrap (do async.monad - [outcome (/.do! (@version.echo "") (program.async (program.mock environment.empty home working_directory)) fs shell ///dependency/resolution.empty - (with_target empty_profile))] - (_.cover' [/.no_specified_program] - (case outcome - (#try.Success _) - false + (in (do async.monad + [outcome (/.do! (@version.echo "") (program.async (program.mock environment.empty home working_directory)) fs shell ///dependency/resolution.empty + (with_target empty_profile))] + (_.cover' [/.no_specified_program] + (case outcome + (#try.Success _) + false - (#try.Failure error) - (exception.match? /.no_specified_program error))))) - (wrap (do async.monad - [outcome (/.do! (@version.echo "") (program.async (program.mock environment.empty home working_directory)) fs shell ///dependency/resolution.empty profile)] - (_.cover' [/.Compiler /.no_available_compiler] - (case outcome - (#try.Success _) - false + (#try.Failure error) + (exception.match? /.no_specified_program error))))) + (in (do async.monad + [outcome (/.do! (@version.echo "") (program.async (program.mock environment.empty home working_directory)) fs shell ///dependency/resolution.empty profile)] + (_.cover' [/.Compiler /.no_available_compiler] + (case outcome + (#try.Success _) + false - (#try.Failure error) - (exception.match? /.no_available_compiler error))))) + (#try.Failure error) + (exception.match? /.no_available_compiler error))))) (do ! [#let [console (@version.echo "")] [compiler resolution] ..resolution] - (wrap (do async.monad - [verdict (do ///action.monad - [_ (/.do! console (program.async (program.mock environment.empty home working_directory)) - fs shell resolution - (set@ #///.compiler compiler profile)) - start (\ console read_line []) - end (\ console read_line [])] - (wrap (and (text\= /.start start) - (text\= /.success end))))] - (_.cover' [/.do! - /.lux_group - /.jvm_compiler_name - /.js_compiler_name - /.python_compiler_name - /.lua_compiler_name - /.ruby_compiler_name - /.start - /.success] - (try.default false verdict))))) + (in (do async.monad + [verdict (do ///action.monad + [_ (/.do! console (program.async (program.mock environment.empty home working_directory)) + fs shell resolution + (set@ #///.compiler compiler profile)) + start (\ console read_line []) + end (\ console read_line [])] + (in (and (text\= /.start start) + (text\= /.success end))))] + (_.cover' [/.do! + /.lux_group + /.jvm_compiler_name + /.js_compiler_name + /.python_compiler_name + /.lua_compiler_name + /.ruby_compiler_name + /.start + /.success] + (try.default false verdict))))) (do ! [#let [console (@version.echo "")] [compiler resolution] ..resolution] - (wrap (do async.monad - [verdict (do ///action.monad - [_ (/.do! console (program.async (program.mock environment.empty home working_directory)) - fs (shell.async (..bad_shell [])) resolution - (set@ #///.compiler compiler profile)) - start (\ console read_line []) - end (\ console read_line [])] - (wrap (and (text\= /.start start) - (text\= /.failure end))))] - (_.cover' [/.failure] - (try.default false verdict))))) + (in (do async.monad + [verdict (do ///action.monad + [_ (/.do! console (program.async (program.mock environment.empty home working_directory)) + fs (shell.async (..bad_shell [])) resolution + (set@ #///.compiler compiler profile)) + start (\ console read_line []) + end (\ console read_line [])] + (in (and (text\= /.start start) + (text\= /.failure end))))] + (_.cover' [/.failure] + (try.default false verdict))))) (do ! [expected/0 (random.ascii/alpha 5) expected/1 (random.ascii/alpha 5) @@ -224,26 +224,26 @@ shell (|> (list expected/0 expected/1 expected/2) (..reader_shell <error?>) shell.async)] - (wrap (do {! async.monad} - [verdict (do ///action.monad - [process (shell [environment.empty working_directory "" (list "")]) - _ (<log!> console process) - actual/0 (\ console read_line []) - actual/1 (\ console read_line []) - actual/2 (\ console read_line []) - end! (|> (\ console read_line []) - (\ ! map (|>> (case> (#try.Failure error) - true - - (#try.Success _) - false) - #try.Success)))] - (wrap (and (text\= expected/0 actual/0) - (text\= expected/1 actual/1) - (text\= expected/2 actual/2) - end!)))] - (_.cover' [<log!>] - (try.default false verdict)))))] + (in (do {! async.monad} + [verdict (do ///action.monad + [process (shell [environment.empty working_directory "" (list "")]) + _ (<log!> console process) + actual/0 (\ console read_line []) + actual/1 (\ console read_line []) + actual/2 (\ console read_line []) + end! (|> (\ console read_line []) + (\ ! map (|>> (case> (#try.Failure error) + true + + (#try.Success _) + false) + #try.Success)))] + (in (and (text\= expected/0 actual/0) + (text\= expected/1 actual/1) + (text\= expected/2 actual/2) + end!)))] + (_.cover' [<log!>] + (try.default false verdict)))))] [#0 /.log_output!] [#1 /.log_error!] diff --git a/stdlib/source/test/aedifex/command/clean.lux b/stdlib/source/test/aedifex/command/clean.lux index 568c6fb76..238fa824b 100644 --- a/stdlib/source/test/aedifex/command/clean.lux +++ b/stdlib/source/test/aedifex/command/clean.lux @@ -46,8 +46,8 @@ [count (\ ! map (n.% 10) random.nat) names (random.set text.hash count ..node_name) contents (random.list count ($binary.random 100))] - (wrap (list.zipped/2 (list\map (|>> (format prefix)) (set.to_list names)) - contents)))) + (in (list.zipped/2 (list\map (|>> (format prefix)) (set.to_list names)) + contents)))) (def: (create_file! fs [path content]) (-> (file.System Async) [Path Binary] (Async (Try Any))) @@ -59,15 +59,15 @@ [_ (: (Async (Try Any)) (file.make_directories async.monad fs path)) _ (monad.map ! (..create_file! fs) files)] - (wrap []))) + (in []))) (def: (directory_exists? fs) (-> (file.System Async) Path (Async (Try Bit))) - (|>> (\ fs directory?) (try.lift async.monad))) + (|>> (\ fs directory?) (try.lifted async.monad))) (def: (file_exists? fs) (-> (file.System Async) Path (Async (Try Bit))) - (|>> (\ fs file?) (try.lift async.monad))) + (|>> (\ fs file?) (try.lifted async.monad))) (def: (assets_exist? fs directory_path files) (-> (file.System Async) Path (List [Path Binary]) (Async (Try Bit))) @@ -77,8 +77,8 @@ (|> files (list\map product.left) (monad.map ///action.monad (..file_exists? fs))))] - (wrap (and directory_exists? - (list.every? (|>>) files_exist?))))) + (in (and directory_exists? + (list.every? (|>>) files_exist?))))) (def: #export test Test @@ -95,25 +95,25 @@ sub_files (..files (format sub_path /)) dummy @profile.random] - (wrap (do async.monad - [#let [console (@version.echo "")] - verdict (do {! (try.with async.monad)} - [_ (..create_directory! fs target_path direct_files) - _ (..create_directory! fs sub_path sub_files) - context_exists!/pre (..directory_exists? fs context) - target_exists!/pre (..assets_exist? fs target_path direct_files) - sub_exists!/pre (..assets_exist? fs sub_path sub_files) - _ (/.do! console fs (set@ #///.target target_path dummy)) - context_exists!/post (..directory_exists? fs context) - target_exists!/post (..assets_exist? fs target_path direct_files) - sub_exists!/post (..assets_exist? fs sub_path sub_files) - logging (\ console read_line [])] - (wrap (and (and context_exists!/pre - context_exists!/post) - (and target_exists!/pre - (not target_exists!/post)) - (and sub_exists!/pre - (not sub_exists!/post)) - (text\= (/.success target_path) logging))))] - (_.cover' [/.do! /.success] - (try.default false verdict))))))) + (in (do async.monad + [#let [console (@version.echo "")] + verdict (do {! (try.with async.monad)} + [_ (..create_directory! fs target_path direct_files) + _ (..create_directory! fs sub_path sub_files) + context_exists!/pre (..directory_exists? fs context) + target_exists!/pre (..assets_exist? fs target_path direct_files) + sub_exists!/pre (..assets_exist? fs sub_path sub_files) + _ (/.do! console fs (set@ #///.target target_path dummy)) + context_exists!/post (..directory_exists? fs context) + target_exists!/post (..assets_exist? fs target_path direct_files) + sub_exists!/post (..assets_exist? fs sub_path sub_files) + logging (\ console read_line [])] + (in (and (and context_exists!/pre + context_exists!/post) + (and target_exists!/pre + (not target_exists!/post)) + (and sub_exists!/pre + (not sub_exists!/post)) + (text\= (/.success target_path) logging))))] + (_.cover' [/.do! /.success] + (try.default false verdict))))))) diff --git a/stdlib/source/test/aedifex/command/deploy.lux b/stdlib/source/test/aedifex/command/deploy.lux index e2f7cfa4a..41a997d6f 100644 --- a/stdlib/source/test/aedifex/command/deploy.lux +++ b/stdlib/source/test/aedifex/command/deploy.lux @@ -67,8 +67,8 @@ (random.one (function (_ profile) (do maybe.monad [artifact (get@ #///.identity profile) - expected_pom (try.to_maybe (///pom.write profile))] - (wrap [artifact expected_pom profile]))) + expected_pom (try.maybe (///pom.write profile))] + (in [artifact expected_pom profile]))) $profile.random) home (random.ascii/alpha 5) @@ -77,52 +77,52 @@ $repository.empty) fs (file.mock (\ file.default separator)) program (program.async (program.mock environment.empty home working_directory))]] - (wrap (do {! async.monad} - [verdict (do {! ///action.monad} - [logging (..execute! program repository fs artifact profile) - expected_library (|> profile - (get@ #///.sources) - set.to_list - (export.library fs) - (\ ! map (format.run tar.writer))) + (in (do {! async.monad} + [verdict (do {! ///action.monad} + [logging (..execute! program repository fs artifact profile) + expected_library (|> profile + (get@ #///.sources) + set.to_list + (export.library fs) + (\ ! map (format.run tar.writer))) - 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 (\ async.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 (\ async.monad wrap + 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 (\ async.monad in (do try.monad - [actual_md5 (\ utf8.codec decode actual_md5)] - (\ ///hash.md5_codec decode actual_md5))) + [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 (\ async.monad in + (do try.monad + [actual_md5 (\ utf8.codec decode actual_md5)] + (\ ///hash.md5_codec decode actual_md5))) - #let [succeeded! - (text\= /.success logging) + #let [succeeded! + (text\= /.success logging) - deployed_library! - (binary\= expected_library - actual_library) + deployed_library! + (binary\= expected_library + actual_library) - deployed_pom! - (binary\= (|> expected_pom (\ xml.codec encode) (\ utf8.codec encode)) - actual_pom) + deployed_pom! + (binary\= (|> expected_pom (\ xml.codec encode) (\ utf8.codec encode)) + actual_pom) - deployed_sha-1! - (\ ///hash.equivalence = - (///hash.sha-1 expected_library) - actual_sha-1) + deployed_sha-1! + (\ ///hash.equivalence = + (///hash.sha-1 expected_library) + actual_sha-1) - deployed_md5! - (\ ///hash.equivalence = - (///hash.md5 expected_library) - actual_md5)]] - (wrap (and succeeded! - deployed_library! - deployed_pom! - deployed_sha-1! - deployed_md5!)))] - (_.cover' [/.do! /.success] - (try.default false verdict))))))) + deployed_md5! + (\ ///hash.equivalence = + (///hash.md5 expected_library) + actual_md5)]] + (in (and succeeded! + deployed_library! + deployed_pom! + deployed_sha-1! + deployed_md5!)))] + (_.cover' [/.do! /.success] + (try.default false verdict))))))) diff --git a/stdlib/source/test/aedifex/command/deps.lux b/stdlib/source/test/aedifex/command/deps.lux index 1a54ae89d..c00c88078 100644 --- a/stdlib/source/test/aedifex/command/deps.lux +++ b/stdlib/source/test/aedifex/command/deps.lux @@ -95,36 +95,36 @@ fs (file.mock (\ file.default separator)) program (program.async (program.mock environment.empty home working_directory))]] - (wrap (do async.monad - [verdict (do ///action.monad - [#let [console (@version.echo "") - local (///repository/local.repository program fs)] - pre (|> ///dependency/resolution.empty - (dictionary.put dependee dependee_package) - (///dependency/deployment.all local)) - post (|> (\ ///.monoid identity) - (set@ #///.dependencies (set.of_list ///dependency.hash (list dependee depender))) - (/.do! console local - (list (///repository.mock ($///dependency/resolution.single depender_artifact depender_package) - [])) - (function (_ url) - (///repository.mock $///dependency/resolution.nope [])))) + (in (do async.monad + [verdict (do ///action.monad + [#let [console (@version.echo "") + local (///repository/local.repository program fs)] + pre (|> ///dependency/resolution.empty + (dictionary.put dependee dependee_package) + (///dependency/deployment.all local)) + post (|> (\ ///.monoid identity) + (set@ #///.dependencies (set.of_list ///dependency.hash (list dependee depender))) + (/.do! console local + (list (///repository.mock ($///dependency/resolution.single depender_artifact depender_package) + [])) + (function (_ url) + (///repository.mock $///dependency/resolution.nope [])))) - #let [had_dependee_before! - (set.member? pre dependee_artifact) + #let [had_dependee_before! + (set.member? pre dependee_artifact) - lacked_depender_before! - (not (set.member? pre depender_artifact)) + lacked_depender_before! + (not (set.member? pre depender_artifact)) - had_dependee_after! - (dictionary.key? post dependee) + had_dependee_after! + (dictionary.key? post dependee) + + had_depender_after! + (dictionary.key? post depender)]] + (in (and had_dependee_before! + lacked_depender_before! - had_depender_after! - (dictionary.key? post depender)]] - (wrap (and had_dependee_before! - lacked_depender_before! - - had_dependee_after! - had_depender_after!)))] - (_.cover' [/.do!] - (try.default false verdict))))))) + had_dependee_after! + had_depender_after!)))] + (_.cover' [/.do!] + (try.default false verdict))))))) diff --git a/stdlib/source/test/aedifex/command/install.lux b/stdlib/source/test/aedifex/command/install.lux index 3ba225206..a9de141ff 100644 --- a/stdlib/source/test/aedifex/command/install.lux +++ b/stdlib/source/test/aedifex/command/install.lux @@ -71,35 +71,35 @@ working_directory (random.ascii/alpha 5) #let [/ (\ file.default separator)]] ($_ _.and - (wrap (do {! async.monad} - [#let [fs (file.mock /) - program (program.async (program.mock environment.empty home working_directory)) + (in (do {! async.monad} + [#let [fs (file.mock /) + program (program.async (program.mock environment.empty home working_directory)) - artifact_path (///local.uri (get@ #///artifact.version identity) identity) - library_path (format artifact_path ///artifact/extension.lux_library) - pom_path (format artifact_path ///artifact/extension.pom)] - verdict (do {! ///action.monad} - [succeeded! (\ ! map (text\= /.success) - (..execute! program fs sample)) - library_exists! (|> library_path - (format home /) - (\ fs file?) - (\ async.monad map exception.return)) - pom_exists! (|> pom_path - (format home /) - (\ fs file?) - (\ async.monad map exception.return))] - (wrap (and succeeded! - library_exists! - pom_exists!)))] - (_.cover' [/.do! /.success] - (try.default false verdict)))) - (wrap (do {! async.monad} - [#let [fs (file.mock /) - program (program.async (program.mock environment.empty home working_directory))] - logging (..execute! program fs (set@ #///.identity #.None sample))] - (_.cover' [/.failure] - (|> logging - (try\map (text\= /.failure)) - (try.default false))))) + artifact_path (///local.uri (get@ #///artifact.version identity) identity) + library_path (format artifact_path ///artifact/extension.lux_library) + pom_path (format artifact_path ///artifact/extension.pom)] + verdict (do {! ///action.monad} + [succeeded! (\ ! map (text\= /.success) + (..execute! program fs sample)) + library_exists! (|> library_path + (format home /) + (\ fs file?) + (\ async.monad map exception.return)) + pom_exists! (|> pom_path + (format home /) + (\ fs file?) + (\ async.monad map exception.return))] + (in (and succeeded! + library_exists! + pom_exists!)))] + (_.cover' [/.do! /.success] + (try.default false verdict)))) + (in (do {! async.monad} + [#let [fs (file.mock /) + program (program.async (program.mock environment.empty home working_directory))] + logging (..execute! program fs (set@ #///.identity #.None sample))] + (_.cover' [/.failure] + (|> logging + (try\map (text\= /.failure)) + (try.default false))))) )))) diff --git a/stdlib/source/test/aedifex/command/pom.lux b/stdlib/source/test/aedifex/command/pom.lux index 4ee1c49f4..ebc0ae09e 100644 --- a/stdlib/source/test/aedifex/command/pom.lux +++ b/stdlib/source/test/aedifex/command/pom.lux @@ -36,35 +36,35 @@ (do random.monad [sample @profile.random #let [fs (file.mock (\ file.default separator))]] - (wrap (do {! async.monad} - [#let [console (@version.echo "")] - outcome (/.do! console fs sample)] - (case outcome - (#try.Success _) - (do ! - [verdict (do ///action.monad - [expected (|> (///pom.write sample) - (try\map (|>> (\ xml.codec encode) - (\ utf8.codec encode))) - (\ ! wrap)) - actual (\ fs read ///pom.file) + (in (do {! async.monad} + [#let [console (@version.echo "")] + outcome (/.do! console fs sample)] + (case outcome + (#try.Success _) + (do ! + [verdict (do ///action.monad + [expected (|> (///pom.write sample) + (try\map (|>> (\ xml.codec encode) + (\ utf8.codec encode))) + (\ ! in)) + actual (\ fs read ///pom.file) - logging! (\ ///action.monad map - (text\= /.success) - (\ console read_line [])) + logging! (\ ///action.monad map + (text\= /.success) + (\ console read_line [])) - #let [expected_content! - (binary\= expected actual)]] - (wrap (and logging! - expected_content!)))] - (_.cover' [/.do! /.success] - (try.default false verdict))) - - (#try.Failure error) - (_.cover' [/.do!] - (case (get@ #///.identity sample) - (#.Some _) - false + #let [expected_content! + (binary\= expected actual)]] + (in (and logging! + expected_content!)))] + (_.cover' [/.do! /.success] + (try.default false verdict))) + + (#try.Failure error) + (_.cover' [/.do!] + (case (get@ #///.identity sample) + (#.Some _) + false - #.None - true)))))))) + #.None + true)))))))) diff --git a/stdlib/source/test/aedifex/command/test.lux b/stdlib/source/test/aedifex/command/test.lux index 5882992a9..93c6642f7 100644 --- a/stdlib/source/test/aedifex/command/test.lux +++ b/stdlib/source/test/aedifex/command/test.lux @@ -61,55 +61,55 @@ ($_ _.and (let [fs (file.mock (\ file.default separator)) console (@version.echo "")] - (wrap (do async.monad - [verdict (do ///action.monad - [_ (/.do! console (program.async (program.mock environment.empty home working_directory)) - fs (shell.async (@build.good_shell [])) resolution - (set@ #///.compiler compiler profile)) - build_start (\ console read_line []) - build_end (\ console read_line []) - test_start (\ console read_line []) - test_end (\ console read_line [])] - (wrap (and (and (text\= //build.start build_start) - (text\= //build.success build_end)) - (and (text\= /.start test_start) - (text\= /.success test_end)))))] - (_.cover' [/.do! - /.start /.success] - (try.default false verdict))))) + (in (do async.monad + [verdict (do ///action.monad + [_ (/.do! console (program.async (program.mock environment.empty home working_directory)) + fs (shell.async (@build.good_shell [])) resolution + (set@ #///.compiler compiler profile)) + build_start (\ console read_line []) + build_end (\ console read_line []) + test_start (\ console read_line []) + test_end (\ console read_line [])] + (in (and (and (text\= //build.start build_start) + (text\= //build.success build_end)) + (and (text\= /.start test_start) + (text\= /.success test_end)))))] + (_.cover' [/.do! + /.start /.success] + (try.default false verdict))))) (let [fs (file.mock (\ file.default separator)) console (@version.echo "")] - (wrap (do async.monad - [verdict (do ///action.monad - [#let [bad_shell (shell.mock - (function (_ [actual_environment actual_working_directory actual_command actual_arguments]) - (#try.Success - (: (shell.Mock []) - (implementation - (def: (on_read state) - (exception.throw shell.no_more_output [])) - (def: (on_error state) - (exception.throw shell.no_more_output [])) - (def: (on_write input state) - (#try.Failure "on_write")) - (def: (on_destroy state) - (#try.Failure "on_destroy")) - (def: (on_await state) - (#try.Success [state (if (list.any? (text\= "build") actual_arguments) - shell.normal - shell.error)])))))) - [])] - _ (/.do! console (program.async (program.mock environment.empty home working_directory)) - fs (shell.async bad_shell) resolution - (set@ #///.compiler compiler profile)) - build_start (\ console read_line []) - build_end (\ console read_line []) - test_start (\ console read_line []) - test_end (\ console read_line [])] - (wrap (and (and (text\= //build.start build_start) - (text\= //build.success build_end)) - (and (text\= /.start test_start) - (text\= /.failure test_end)))))] - (_.cover' [/.failure] - (try.default false verdict))))) + (in (do async.monad + [verdict (do ///action.monad + [#let [bad_shell (shell.mock + (function (_ [actual_environment actual_working_directory actual_command actual_arguments]) + (#try.Success + (: (shell.Mock []) + (implementation + (def: (on_read state) + (exception.except shell.no_more_output [])) + (def: (on_error state) + (exception.except shell.no_more_output [])) + (def: (on_write input state) + (#try.Failure "on_write")) + (def: (on_destroy state) + (#try.Failure "on_destroy")) + (def: (on_await state) + (#try.Success [state (if (list.any? (text\= "build") actual_arguments) + shell.normal + shell.error)])))))) + [])] + _ (/.do! console (program.async (program.mock environment.empty home working_directory)) + fs (shell.async bad_shell) resolution + (set@ #///.compiler compiler profile)) + build_start (\ console read_line []) + build_end (\ console read_line []) + test_start (\ console read_line []) + test_end (\ console read_line [])] + (in (and (and (text\= //build.start build_start) + (text\= //build.success build_end)) + (and (text\= /.start test_start) + (text\= /.failure test_end)))))] + (_.cover' [/.failure] + (try.default false verdict))))) )))) diff --git a/stdlib/source/test/aedifex/command/version.lux b/stdlib/source/test/aedifex/command/version.lux index 739a02fef..30c7d3f80 100644 --- a/stdlib/source/test/aedifex/command/version.lux +++ b/stdlib/source/test/aedifex/command/version.lux @@ -39,23 +39,23 @@ (do maybe.monad [head (text.nth 0 state) [_ tail] (text.split 1 state)] - (wrap [[open? tail] head]))) - (exception.throw ..console_is_closed! []))) + (in [[open? tail] head]))) + (exception.except ..console_is_closed! []))) (def: (on_read_line [open? state]) (if open? (try.of_maybe (do maybe.monad [[output state] (text.split_with text.new_line state)] - (wrap [[open? state] output]))) - (exception.throw ..console_is_closed! []))) + (in [[open? state] output]))) + (exception.except ..console_is_closed! []))) (def: (on_write input [open? state]) (if open? (#try.Success [open? (format state input)]) - (exception.throw ..console_is_closed! []))) + (exception.except ..console_is_closed! []))) (def: (on_close [open? buffer]) (if open? (#try.Success [false buffer]) - (exception.throw ..console_is_closed! [])))) + (exception.except ..console_is_closed! [])))) (def: #export echo (-> Text (Console Async)) @@ -68,12 +68,12 @@ (<| (_.covering /._) (do random.monad [profile @profile.random] - (wrap (do async.monad - [#let [console (..echo "")] - verdict (do (try.with async.monad) - [_ (/.do! console profile) - logging (\ console read_line [])] - (wrap (text\= (version.format language/lux.version) - logging)))] - (_.cover' [/.do!] - (try.default false verdict))))))) + (in (do async.monad + [#let [console (..echo "")] + verdict (do (try.with async.monad) + [_ (/.do! console profile) + logging (\ console read_line [])] + (in (text\= (version.format language/lux.version) + logging)))] + (_.cover' [/.do!] + (try.default false verdict))))))) diff --git a/stdlib/source/test/aedifex/dependency/deployment.lux b/stdlib/source/test/aedifex/dependency/deployment.lux index 218bbaf07..3688e56aa 100644 --- a/stdlib/source/test/aedifex/dependency/deployment.lux +++ b/stdlib/source/test/aedifex/dependency/deployment.lux @@ -72,8 +72,8 @@ (atom.update (dictionary.put url input) cache) _ - (wrap [])))] - (wrap (#try.Success ..good_upload)))))) + (in [])))] + (in (#try.Success ..good_upload)))))) (def: (verify_one expected_deployments address package cache expected_artifact actual_artifact) (-> Nat URL Package (Dictionary URL Binary) Artifact Artifact Bit) @@ -141,7 +141,7 @@ dependency (: Dependency [artifact artifact/type.lux_library])]] - (wrap [dependency artifact package]))) + (in [dependency artifact package]))) (def: #export test Test @@ -156,13 +156,13 @@ (atom.atom (dictionary.new text.hash))) http (..http cache) repository (repository.async (remote.repository http #.None address))]] - (wrap (do async.monad - [?outcome (/.one repository dependency package) - cache (async.future (atom.read cache))] - (_.cover' [/.one] - (|> ?outcome - (try\map (verify_one 1 address package cache expected_artifact)) - (try.default false)))))) + (in (do async.monad + [?outcome (/.one repository dependency package) + cache (async.future (atom.read cache))] + (_.cover' [/.one] + (|> ?outcome + (try\map (verify_one 1 address package cache expected_artifact)) + (try.default false)))))) (do {! random.monad} [#let [hash (: (Hash [Dependency Artifact Package]) (\ hash.functor map (|>> product.right product.left product.left) @@ -179,26 +179,26 @@ (atom.atom (dictionary.new text.hash))) http (..http cache) repository (repository.async (remote.repository http #.None address))]] - (wrap (do async.monad - [?outcome (/.all repository resolution) - cache (async.future (atom.read cache))] - (_.cover' [/.all] - (|> ?outcome - (try\map (function (_ actual_artifacts) - (let [expected_deployments! - (n.= num_bundles (set.size actual_artifacts)) + (in (do async.monad + [?outcome (/.all repository resolution) + cache (async.future (atom.read cache))] + (_.cover' [/.all] + (|> ?outcome + (try\map (function (_ actual_artifacts) + (let [expected_deployments! + (n.= num_bundles (set.size actual_artifacts)) - every_deployment_was_correct! - (list.every? (function (_ [dependency expected_artifact package]) - (let [deployed! - (set.member? actual_artifacts expected_artifact) + every_deployment_was_correct! + (list.every? (function (_ [dependency expected_artifact package]) + (let [deployed! + (set.member? actual_artifacts expected_artifact) - deployed_correctly! - (verify_one num_bundles address package cache expected_artifact expected_artifact)] - (and deployed! - deployed_correctly!))) - bundles)] - (and expected_deployments! - every_deployment_was_correct!)))) - (try.default false)))))) + deployed_correctly! + (verify_one num_bundles address package cache expected_artifact expected_artifact)] + (and deployed! + deployed_correctly!))) + bundles)] + (and expected_deployments! + every_deployment_was_correct!)))) + (try.default false)))))) )))) diff --git a/stdlib/source/test/aedifex/dependency/resolution.lux b/stdlib/source/test/aedifex/dependency/resolution.lux index ea468f851..fa0391761 100644 --- a/stdlib/source/test/aedifex/dependency/resolution.lux +++ b/stdlib/source/test/aedifex/dependency/resolution.lux @@ -53,10 +53,10 @@ (do {! random.monad} [artifact $///artifact.random [_ package] $///package.random] - (wrap (dictionary.put {#///dependency.artifact artifact - #///dependency.type ///artifact/type.lux_library} - package - /.empty)))) + (in (dictionary.put {#///dependency.artifact artifact + #///dependency.type ///artifact/type.lux_library} + package + /.empty)))) (def: lux_sha-1 Text @@ -258,33 +258,31 @@ bad_sha-1 (..bad_sha-1 expected_artifact expected_package dummy_package) bad_md5 (..bad_md5 expected_artifact expected_package dummy_package)]] (`` ($_ _.and - (wrap - (do async.monad - [actual_package (/.one (///repository.mock good []) - {#///dependency.artifact expected_artifact - #///dependency.type ///artifact/type.lux_library})] - (_.cover' [/.one] - (case actual_package - (#try.Success actual_package) - (\ ///package.equivalence = - (set@ #///package.origin (#///repository/origin.Remote "") expected_package) - actual_package) - - (#try.Failure _) - false)))) + (in (do async.monad + [actual_package (/.one (///repository.mock good []) + {#///dependency.artifact expected_artifact + #///dependency.type ///artifact/type.lux_library})] + (_.cover' [/.one] + (case actual_package + (#try.Success actual_package) + (\ ///package.equivalence = + (set@ #///package.origin (#///repository/origin.Remote "") expected_package) + actual_package) + + (#try.Failure _) + false)))) (~~ (template [<exception> <bad>] - [(wrap - (do async.monad - [actual_package (/.one (///repository.mock <bad> []) - {#///dependency.artifact expected_artifact - #///dependency.type ///artifact/type.lux_library})] - (_.cover' [<exception>] - (case actual_package - (#try.Failure error) - (exception.match? <exception> error) - - (#try.Success _) - false))))] + [(in (do async.monad + [actual_package (/.one (///repository.mock <bad> []) + {#///dependency.artifact expected_artifact + #///dependency.type ///artifact/type.lux_library})] + (_.cover' [<exception>] + (case actual_package + (#try.Failure error) + (exception.match? <exception> error) + + (#try.Success _) + false))))] [/.sha-1_does_not_match bad_sha-1] [/.md5_does_not_match bad_md5] @@ -305,39 +303,37 @@ bad_sha-1 (..bad_sha-1 expected_artifact expected_package dummy_package) bad_md5 (..bad_md5 expected_artifact expected_package dummy_package)]] ($_ _.and - (wrap - (do async.monad - [#let [console ($///version.echo "")] - actual_package (/.any console - (list (///repository.mock bad_sha-1 []) - (///repository.mock bad_md5 []) - (///repository.mock good [])) - {#///dependency.artifact expected_artifact - #///dependency.type ///artifact/type.lux_library})] - (_.cover' [/.any] - (case actual_package - (#try.Success actual_package) - (\ ///package.equivalence = - (set@ #///package.origin (#///repository/origin.Remote "") expected_package) - actual_package) - - (#try.Failure _) - false)))) - (wrap - (do async.monad - [#let [console ($///version.echo "")] - actual_package (/.any console - (list (///repository.mock bad_sha-1 []) - (///repository.mock bad_md5 [])) - {#///dependency.artifact expected_artifact - #///dependency.type ///artifact/type.lux_library})] - (_.cover' [/.cannot_resolve] - (case actual_package - (#try.Failure error) - (exception.match? /.cannot_resolve error) - - (#try.Success _) - false)))) + (in (do async.monad + [#let [console ($///version.echo "")] + actual_package (/.any console + (list (///repository.mock bad_sha-1 []) + (///repository.mock bad_md5 []) + (///repository.mock good [])) + {#///dependency.artifact expected_artifact + #///dependency.type ///artifact/type.lux_library})] + (_.cover' [/.any] + (case actual_package + (#try.Success actual_package) + (\ ///package.equivalence = + (set@ #///package.origin (#///repository/origin.Remote "") expected_package) + actual_package) + + (#try.Failure _) + false)))) + (in (do async.monad + [#let [console ($///version.echo "")] + actual_package (/.any console + (list (///repository.mock bad_sha-1 []) + (///repository.mock bad_md5 [])) + {#///dependency.artifact expected_artifact + #///dependency.type ///artifact/type.lux_library})] + (_.cover' [/.cannot_resolve] + (case actual_package + (#try.Failure error) + (exception.match? /.cannot_resolve error) + + (#try.Success _) + false)))) ))) (def: artifacts @@ -351,7 +347,7 @@ (predicate.unite (\ ///artifact.equivalence = dependee_artifact) (\ ///artifact.equivalence = depender_artifact))) $///artifact.random)] - (wrap [dependee_artifact depender_artifact ignored_artifact]))) + (in [dependee_artifact depender_artifact ignored_artifact]))) (def: (packages [dependee_artifact depender_artifact ignored_artifact]) (-> [Artifact Artifact Artifact] @@ -398,8 +394,8 @@ (|> ignored_pom (\ xml.codec encode) (\ utf8.codec encode)) #///dependency/status.Unverified] ignored_package)]] - (wrap [[dependee depender ignored] - [dependee_package depender_package ignored_package]]))) + (in [[dependee depender ignored] + [dependee_package depender_package ignored_package]]))) (def: all Test @@ -410,26 +406,25 @@ [dependee_package depender_package ignored_package]] (..packages [dependee_artifact depender_artifact ignored_artifact])] ($_ _.and - (wrap - (do async.monad - [#let [console ($///version.echo "")] - [successes failures resolution] (/.all console - (list (///repository.mock (..single dependee_artifact dependee_package) []) - (///repository.mock (..single depender_artifact depender_package) []) - (///repository.mock (..single ignored_artifact ignored_package) [])) - (function (_ url) - (///repository.mock ..nope [])) - (list depender) - /.empty)] - (_.cover' [/.all] - (and (dictionary.key? resolution depender) - (list.any? (///dependency\= depender) successes) - - (dictionary.key? resolution dependee) - (list.any? (///dependency\= dependee) successes) - - (list.empty? failures) - (not (dictionary.key? resolution ignored)))))) + (in (do async.monad + [#let [console ($///version.echo "")] + [successes failures resolution] (/.all console + (list (///repository.mock (..single dependee_artifact dependee_package) []) + (///repository.mock (..single depender_artifact depender_package) []) + (///repository.mock (..single ignored_artifact ignored_package) [])) + (function (_ url) + (///repository.mock ..nope [])) + (list depender) + /.empty)] + (_.cover' [/.all] + (and (dictionary.key? resolution depender) + (list.any? (///dependency\= depender) successes) + + (dictionary.key? resolution dependee) + (list.any? (///dependency\= dependee) successes) + + (list.empty? failures) + (not (dictionary.key? resolution ignored)))))) ))) (def: #export test diff --git a/stdlib/source/test/aedifex/dependency/status.lux b/stdlib/source/test/aedifex/dependency/status.lux index 64bb2f642..5b446d643 100644 --- a/stdlib/source/test/aedifex/dependency/status.lux +++ b/stdlib/source/test/aedifex/dependency/status.lux @@ -21,7 +21,7 @@ (def: #export random (Random /.Status) ($_ random.or - (random\wrap []) + (random\in []) (random.or ($///hash.random ///hash.sha-1) ($///hash.random ///hash.md5)) (random.and ($///hash.random ///hash.sha-1) diff --git a/stdlib/source/test/aedifex/input.lux b/stdlib/source/test/aedifex/input.lux index e7f02569f..0cea854c4 100644 --- a/stdlib/source/test/aedifex/input.lux +++ b/stdlib/source/test/aedifex/input.lux @@ -48,19 +48,19 @@ [expected (\ ! map (set@ #//.parents (list)) $profile.random) #let [fs (: (file.System Async) (file.mock (\ file.default separator)))]] - (wrap (do async.monad - [verdict (do //action.monad - [#let [profile (|> expected - //format.profile - %.code - (\ utf8.codec encode))] - _ (\ fs write profile //project.file) - actual (: (Async (Try Profile)) - (/.read async.monad fs //.default))] - (wrap (\ //.equivalence = - (|> expected - (update@ #//.sources ..with_default_source) - (update@ #//.repositories ..with_default_repository)) - actual)))] - (_.cover' [/.read] - (try.default false verdict))))))) + (in (do async.monad + [verdict (do //action.monad + [#let [profile (|> expected + //format.profile + %.code + (\ utf8.codec encode))] + _ (\ fs write profile //project.file) + actual (: (Async (Try Profile)) + (/.read async.monad fs //.default))] + (in (\ //.equivalence = + (|> expected + (update@ #//.sources ..with_default_source) + (update@ #//.repositories ..with_default_repository)) + actual)))] + (_.cover' [/.read] + (try.default false verdict))))))) diff --git a/stdlib/source/test/aedifex/metadata/artifact.lux b/stdlib/source/test/aedifex/metadata/artifact.lux index 6a2106ad3..acd0575a0 100644 --- a/stdlib/source/test/aedifex/metadata/artifact.lux +++ b/stdlib/source/test/aedifex/metadata/artifact.lux @@ -54,17 +54,17 @@ hour (\ ! map (n.% 24) random.nat) minute (\ ! map (n.% 60) random.nat) second (\ ! map (n.% 60) random.nat)] - (wrap (try.assumed - (do try.monad - [year (year.year year) - month (month.by_number month) - date (date.date year month day_of_month) - time (time.time - {#time.hour hour - #time.minute minute - #time.second second - #time.milli_second 0})] - (wrap (instant.of_date_time date time)))))))) + (in (try.assumed + (do try.monad + [year (year.year year) + month (month.by_number month) + date (date.date year month day_of_month) + time (time.time + {#time.hour hour + #time.minute minute + #time.second second + #time.milli_second 0})] + (in (instant.of_date_time date time)))))))) (def: #export test Test @@ -100,17 +100,17 @@ #let [program (program.async (program.mock environment.empty home working_directory)) fs (file.mock (\ file.default separator)) repository (///repository/local.repository program fs)]] - (wrap (do async.monad - [wrote? (/.write repository artifact expected) - actual (/.read repository artifact)] - (_.cover' [/.write /.read] - (and (case wrote? - (#try.Success _) true - (#try.Failure _) false) - (case actual - (#try.Success actual) - (\ /.equivalence = expected actual) - - (#try.Failure _) - false)))))) + (in (do async.monad + [wrote? (/.write repository artifact expected) + actual (/.read repository artifact)] + (_.cover' [/.write /.read] + (and (case wrote? + (#try.Success _) true + (#try.Failure _) false) + (case actual + (#try.Success actual) + (\ /.equivalence = expected actual) + + (#try.Failure _) + false)))))) )))) diff --git a/stdlib/source/test/aedifex/metadata/snapshot.lux b/stdlib/source/test/aedifex/metadata/snapshot.lux index ea0a26a5a..c9787d8bb 100644 --- a/stdlib/source/test/aedifex/metadata/snapshot.lux +++ b/stdlib/source/test/aedifex/metadata/snapshot.lux @@ -58,22 +58,22 @@ hour (\ ! map (n.% 24) random.nat) minute (\ ! map (n.% 60) random.nat) second (\ ! map (n.% 60) random.nat)] - (wrap (try.assumed - (do try.monad - [year (year.year year) - month (month.by_number month) - date (date.date year month day_of_month) - time (time.time - {#time.hour hour - #time.minute minute - #time.second second - #time.milli_second 0})] - (wrap (instant.of_date_time date time))))))) + (in (try.assumed + (do try.monad + [year (year.year year) + month (month.by_number month) + date (date.date year month day_of_month) + time (time.time + {#time.hour hour + #time.minute minute + #time.second second + #time.milli_second 0})] + (in (instant.of_date_time date time))))))) (def: random_versioning (Random Versioning) ($_ random.and - (random\wrap #///snapshot.Local) + (random\in #///snapshot.Local) $///artifact/time.random (random.list 5 $///artifact/snapshot/version.random) )) @@ -112,17 +112,17 @@ #let [program (program.async (program.mock environment.empty home working_directory)) fs (file.mock (\ file.default separator)) repository (///repository/local.repository program fs)]] - (wrap (do async.monad - [wrote? (/.write repository artifact expected) - actual (/.read repository artifact)] - (_.cover' [/.write /.read] - (and (case wrote? - (#try.Success _) true - (#try.Failure _) false) - (case actual - (#try.Success actual) - (\ /.equivalence = expected actual) - - (#try.Failure _) - false)))))) + (in (do async.monad + [wrote? (/.write repository artifact expected) + actual (/.read repository artifact)] + (_.cover' [/.write /.read] + (and (case wrote? + (#try.Success _) true + (#try.Failure _) false) + (case actual + (#try.Success actual) + (\ /.equivalence = expected actual) + + (#try.Failure _) + false)))))) )))) diff --git a/stdlib/source/test/aedifex/package.lux b/stdlib/source/test/aedifex/package.lux index 61201456a..8896b731d 100644 --- a/stdlib/source/test/aedifex/package.lux +++ b/stdlib/source/test/aedifex/package.lux @@ -46,12 +46,12 @@ [content_size (\ ! map (n.% 100) random.nat) content ($binary.random content_size) [profile pom] (random.one (function (_ profile) - (try.to_maybe + (try.maybe (do try.monad [pom (//pom.write profile)] - (wrap [profile pom])))) + (in [profile pom])))) $profile.random)] - (wrap [profile (/.local pom content)]))) + (in [profile (/.local pom content)]))) (def: #export test Test @@ -94,7 +94,7 @@ (|> (do try.monad [xml_pom (\ utf8.codec decode binary_pom) decoded_pom (\ xml.codec decode xml_pom)] - (wrap (\ xml.equivalence = actual_pom decoded_pom))) + (in (\ xml.equivalence = actual_pom decoded_pom))) (try.default false)) (case pom_status (#//status.Verified actual_sha1 expected_md5) diff --git a/stdlib/source/test/aedifex/profile.lux b/stdlib/source/test/aedifex/profile.lux index f29ae7087..755c0e13a 100644 --- a/stdlib/source/test/aedifex/profile.lux +++ b/stdlib/source/test/aedifex/profile.lux @@ -36,8 +36,8 @@ (def: distribution (Random /.Distribution) - (random.or (random\wrap []) - (random\wrap []))) + (random.or (random\in []) + (random\in []))) (def: license (Random /.License) @@ -131,11 +131,11 @@ (random.maybe (random.ascii/alpha 1)) (random.maybe (random.ascii/alpha 1)) (..dictionary_of text.hash (random.ascii/alpha 1) ..repository) - (random\wrap //runtime.default_java) - (random\wrap //runtime.default_js) - (random\wrap //runtime.default_python) - (random\wrap //runtime.default_lua) - (random\wrap //runtime.default_ruby) + (random\in //runtime.default_java) + (random\in //runtime.default_js) + (random\in //runtime.default_python) + (random\in //runtime.default_lua) + (random\in //runtime.default_ruby) )) (def: #export test diff --git a/stdlib/source/test/aedifex/project.lux b/stdlib/source/test/aedifex/project.lux index d76d4afb3..4df06a337 100644 --- a/stdlib/source/test/aedifex/project.lux +++ b/stdlib/source/test/aedifex/project.lux @@ -34,7 +34,7 @@ (Random /.Project) (do random.monad [[name profile] ..profile] - (wrap (/.project name profile)))) + (in (/.project name profile)))) (def: #export test Test diff --git a/stdlib/source/test/aedifex/repository.lux b/stdlib/source/test/aedifex/repository.lux index 67cc4c10f..a926db9a7 100644 --- a/stdlib/source/test/aedifex/repository.lux +++ b/stdlib/source/test/aedifex/repository.lux @@ -74,14 +74,14 @@ (case (dictionary.get uri state) (#.Some content) (case (binary.size content) - 0 (exception.throw ..not_found [uri]) + 0 (exception.except ..not_found [uri]) _ (exception.return [state content])) #.None - (exception.throw ..not_found [uri]))) + (exception.except ..not_found [uri]))) (def: (on_upload uri content state) (if (dictionary.key? state uri) - (exception.throw ..cannot_upload [uri]) + (exception.except ..cannot_upload [uri]) (exception.return (dictionary.put uri content state))))) (def: #export test @@ -90,7 +90,7 @@ ($_ _.and (_.for [/.mock /.Mock] (do random.monad - [_ (wrap [])] + [_ (in [])] ($/.spec (..artifact ..valid_version) (..artifact ..invalid_version) (/.mock ..mock diff --git a/stdlib/source/test/aedifex/repository/local.lux b/stdlib/source/test/aedifex/repository/local.lux index a40924dea..180ea404a 100644 --- a/stdlib/source/test/aedifex/repository/local.lux +++ b/stdlib/source/test/aedifex/repository/local.lux @@ -38,15 +38,15 @@ expected (\ ! map (\ utf8.codec encode) (random.ascii/lower 10))] ($_ _.and - (wrap (do async.monad - [before_upload (\ repo download uri) - _ (\ repo upload uri expected) - actual (\ repo download uri)] - (_.cover' [/.repository] - (and (case before_upload - (#try.Success _) false - (#try.Failure _) true) - (|> actual - (try\map (binary\= expected)) - (try.default false)))))) + (in (do async.monad + [before_upload (\ repo download uri) + _ (\ repo upload uri expected) + actual (\ repo download uri)] + (_.cover' [/.repository] + (and (case before_upload + (#try.Success _) false + (#try.Failure _) true) + (|> actual + (try\map (binary\= expected)) + (try.default false)))))) )))) diff --git a/stdlib/source/test/aedifex/runtime.lux b/stdlib/source/test/aedifex/runtime.lux index f9749c968..cb6d1a8fe 100644 --- a/stdlib/source/test/aedifex/runtime.lux +++ b/stdlib/source/test/aedifex/runtime.lux @@ -22,11 +22,11 @@ (def: #export random (Random /.Runtime) ($_ random.either - (random\wrap /.default_java) - (random\wrap /.default_js) - (random\wrap /.default_python) - (random\wrap /.default_lua) - (random\wrap /.default_ruby) + (random\in /.default_java) + (random\in /.default_js) + (random\in /.default_python) + (random\in /.default_lua) + (random\in /.default_ruby) )) (def: #export test diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index cd77beb6f..de99ee775 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -58,25 +58,9 @@ (template: (!bundle body) (: Test (do random.monad - [_ (wrap [])] + [_ (in [])] body))) -(def: prelude_macros - Test - ($_ _.and - (do random.monad - [factor (random\map (|>> (n.% 10) (n.max 1)) random.nat) - iterations (random\map (n.% 10) random.nat) - #let [expected (n.* factor iterations)]] - (_.test "Can write loops." - (n.= expected - (loop [counter 0 - value 0] - (if (n.< iterations counter) - (recur (inc counter) (n.+ factor value)) - value))))) - )) - (def: sub_tests Test (with_expansions [## TODO: Update & expand tests for this @@ -421,7 +405,7 @@ )))) (/.macro: (identity_macro tokens) - (\ meta.monad wrap tokens)) + (\ meta.monad in tokens)) (def: for_macro Test @@ -621,8 +605,8 @@ (def: for_static Test (do random.monad - [sample (random.either (wrap option/0) - (wrap option/1))] + [sample (random.either (in option/0) + (in option/1))] ($_ _.and (_.cover [/.static] (case sample @@ -862,12 +846,12 @@ (do {! random.monad} [expected_nat (\ ! map (n.% 1) random.nat) expected_int (\ ! map (i.% +1) random.int) - expected_rev (random.either (wrap .5) - (wrap .25)) - expected_frac (random.either (wrap +0.5) - (wrap +1.25)) - expected_text (random.either (wrap "+0.5") - (wrap "+1.25"))] + expected_rev (random.either (in .5) + (in .25)) + expected_frac (random.either (in +0.5) + (in +1.25)) + expected_text (random.either (in "+0.5") + (in "+1.25"))] ($_ _.and (_.cover [/.case] (and (/.case expected_nat @@ -963,13 +947,35 @@ (/.is? expected_int actual_right))))) ))) +(def: for_control_flow + Test + ($_ _.and + (do random.monad + [factor (random\map (|>> (n.% 10) (n.max 1)) random.nat) + iterations (random\map (n.% 10) random.nat) + #let [expected (n.* factor iterations)]] + (_.cover [/.loop] + (n.= expected + (/.loop [counter 0 + value 0] + (if (n.< iterations counter) + (recur (inc counter) (n.+ factor value)) + value))))) + (do random.monad + [pre random.nat + post (random.only (|>> (n.= pre) not) random.nat) + #let [box (atom.atom pre)]] + (_.cover [/.exec] + (and (is? pre (io.run (atom.read box))) + (/.exec + (io.run (atom.write post box)) + (is? post (io.run (atom.read box))))))) + )) + (def: test Test (<| (_.covering /._) ($_ _.and - (<| (_.context "Prelude macros.") - ..prelude_macros) - ..for_bit ..for_try ..for_list @@ -988,6 +994,7 @@ ..for_expansion ..for_value ..for_case + ..for_control_flow ..sub_tests ))) diff --git a/stdlib/source/test/lux/abstract/comonad.lux b/stdlib/source/test/lux/abstract/comonad.lux index 9b4d935d8..eb50c0f53 100644 --- a/stdlib/source/test/lux/abstract/comonad.lux +++ b/stdlib/source/test/lux/abstract/comonad.lux @@ -23,6 +23,6 @@ (n.= (inc sample) (: (Identity Nat) (/.be identity.comonad - [value (unwrap sample)] - (unwrap (inc value)))))) + [value (out sample)] + (out (inc value)))))) )))) diff --git a/stdlib/source/test/lux/abstract/comonad/cofree.lux b/stdlib/source/test/lux/abstract/comonad/cofree.lux index d44c592d0..ecb90c77c 100644 --- a/stdlib/source/test/lux/abstract/comonad/cofree.lux +++ b/stdlib/source/test/lux/abstract/comonad/cofree.lux @@ -26,7 +26,7 @@ (def: (interpret [head tail]) (All [a] (-> (/.CoFree Sequence a) (Sequence a))) (|> tail - (sequence\map (\ (/.comonad sequence.functor) unwrap)) + (sequence\map (\ (/.comonad sequence.functor) out)) [head] //.pending)) diff --git a/stdlib/source/test/lux/abstract/interval.lux b/stdlib/source/test/lux/abstract/interval.lux index deab85fe1..60eeba3df 100644 --- a/stdlib/source/test/lux/abstract/interval.lux +++ b/stdlib/source/test/lux/abstract/interval.lux @@ -28,8 +28,8 @@ top (random.only (|>> (n.= bottom) not) random.nat)] (if (<cmp> top bottom) - (wrap (/.between n.enum bottom top)) - (wrap (/.between n.enum top bottom)))))] + (in (/.between n.enum bottom top)) + (in (/.between n.enum top bottom)))))] [inner n.<] [outer n.>] @@ -39,7 +39,7 @@ (Random (Interval Nat)) (do random.monad [point random.nat] - (wrap (/.singleton n.enum point)))) + (in (/.singleton n.enum point)))) (def: #export interval (Random (Interval Nat)) diff --git a/stdlib/source/test/lux/abstract/monad.lux b/stdlib/source/test/lux/abstract/monad.lux index 2c6fb3ac7..02264e013 100644 --- a/stdlib/source/test/lux/abstract/monad.lux +++ b/stdlib/source/test/lux/abstract/monad.lux @@ -24,19 +24,19 @@ (n.= (inc mono) (: (Identity Nat) (/.do identity.monad - [sample (wrap mono)] - (wrap (inc sample)))))) + [sample (in mono)] + (in (inc sample)))))) (_.cover [/.bind] (n.= (inc mono) (: (Identity Nat) (/.bind identity.monad - (|>> inc (\ identity.monad wrap)) - (\ identity.monad wrap mono))))) + (|>> inc (\ identity.monad in)) + (\ identity.monad in mono))))) (_.cover [/.seq] (\ (list.equivalence n.equivalence) = (list\map inc poly) (|> poly - (list\map (|>> inc (\ identity.monad wrap))) + (list\map (|>> inc (\ identity.monad in))) (: (List (Identity Nat))) (/.seq identity.monad) (: (Identity (List Nat)))))) @@ -44,20 +44,20 @@ (\ (list.equivalence n.equivalence) = (list\map inc poly) (|> poly - (/.map identity.monad (|>> inc (\ identity.monad wrap))) + (/.map identity.monad (|>> inc (\ identity.monad in))) (: (Identity (List Nat)))))) (_.cover [/.only] (\ (list.equivalence n.equivalence) = (list.only n.even? poly) (|> poly - (/.only identity.monad (|>> n.even? (\ identity.monad wrap))) + (/.only identity.monad (|>> n.even? (\ identity.monad in))) (: (Identity (List Nat)))))) (_.cover [/.fold] (n.= (list\fold n.+ 0 poly) (|> poly (/.fold identity.monad (function (_ part whole) - (\ identity.monad wrap + (\ identity.monad in (n.+ part whole))) 0) (: (Identity Nat))))) diff --git a/stdlib/source/test/lux/abstract/predicate.lux b/stdlib/source/test/lux/abstract/predicate.lux index d66513b63..0e902fb40 100644 --- a/stdlib/source/test/lux/abstract/predicate.lux +++ b/stdlib/source/test/lux/abstract/predicate.lux @@ -57,12 +57,12 @@ (bit\= false (/.none sample))) (_.cover [/.all] (bit\= true (/.all sample))) - (_.cover [/.unite] + (_.cover [/.or] (bit\= (/.all sample) - ((/.unite /.none /.all) sample))) - (_.cover [/.intersect] + ((/.or /.none /.all) sample))) + (_.cover [/.and] (bit\= (/.none sample) - ((/.intersect /.none /.all) sample))) + ((/.and /.none /.all) sample))) (_.cover [/.complement] (and (not (bit\= (/.none sample) ((/.complement /.none) sample))) diff --git a/stdlib/source/test/lux/control/concurrency/actor.lux b/stdlib/source/test/lux/control/concurrency/actor.lux index 5ca5d7659..6ccc1a7b2 100644 --- a/stdlib/source/test/lux/control/concurrency/actor.lux +++ b/stdlib/source/test/lux/control/concurrency/actor.lux @@ -36,7 +36,7 @@ (message: (count! {increment Nat} state self) Nat (let [state' (n.+ increment state)] - (async\wrap (#try.Success [state' state'])))) + (async\in (#try.Success [state' state'])))) ) (def: (mailed? outcome) @@ -52,7 +52,7 @@ #let [as_mail (: (All [a] (-> (-> a a) (/.Mail a))) (function (_ transform) (function (_ state actor) - (|> state transform #try.Success async\wrap)))) + (|> state transform #try.Success async\in)))) inc! (: (/.Mail Nat) (as_mail inc)) dec! (: (/.Mail Nat) (as_mail dec))]] (<| (_.covering /._) @@ -69,133 +69,133 @@ [actor (/.spawn! /.default 0) poisoned? (/.poison! actor) alive? (/.alive? actor)] - (wrap (and (..mailed? poisoned?) - (not alive?))))) + (in (and (..mailed? poisoned?) + (not alive?))))) cannot_poison_more_than_once! (io.run (do io.monad [actor (/.spawn! /.default 0) first_time? (/.poison! actor) second_time? (/.poison! actor)] - (wrap (and (..mailed? first_time?) - (not (..mailed? second_time?))))))] + (in (and (..mailed? first_time?) + (not (..mailed? second_time?))))))] (and poisoned_actors_die! cannot_poison_more_than_once!))) (let [[read write] (: [(Async Text) (Resolver Text)] (async.async []))] - (wrap (do async.monad - [_ (async.future (do io.monad - [actor (/.spawn! (: (/.Behavior Any Any) - {#/.on_init (|>>) - #/.on_mail (function (_ message state self) - (do {! async.monad} - [outcome (message state self)] - (case outcome - (#try.Failure cause) - (do ! - [_ (async.future (write cause))] - (wrap outcome)) - - (#try.Success _) - (wrap outcome))))}) - [])] - (/.poison! actor))) - _ (async.wait 100) - result (async.future (async.poll read))] - (_.cover' [/.poisoned] - (case result - (#.Some error) - (exception.match? /.poisoned error) - - #.None - false))))) - - (wrap (do async.monad - [sent? (async.future (do io.monad - [actor (/.spawn! /.default 0) - sent? (/.mail! inc! actor)] - (wrap (..mailed? sent?))))] - (_.cover' [/.Behavior /.Mail - /.default /.spawn! /.mail!] - sent?))) - - (wrap (do async.monad - [result (async.future (do io.monad - [counter (/.spawn! /.default 0) - _ (/.poison! counter)] - (/.mail! inc! counter)))] - (_.cover' [/.dead] + (in (do async.monad + [_ (async.future (do io.monad + [actor (/.spawn! (: (/.Behavior Any Any) + {#/.on_init (|>>) + #/.on_mail (function (_ message state self) + (do {! async.monad} + [outcome (message state self)] + (case outcome + (#try.Failure cause) + (do ! + [_ (async.future (write cause))] + (in outcome)) + + (#try.Success _) + (in outcome))))}) + [])] + (/.poison! actor))) + _ (async.wait 100) + result (async.future (async.poll read))] + (_.cover' [/.poisoned] (case result - (#try.Success outcome) - false - - (#try.Failure error) - (exception.match? /.dead error))))) + (#.Some error) + (exception.match? /.poisoned error) + + #.None + false))))) + + (in (do async.monad + [sent? (async.future (do io.monad + [actor (/.spawn! /.default 0) + sent? (/.mail! inc! actor)] + (in (..mailed? sent?))))] + (_.cover' [/.Behavior /.Mail + /.default /.spawn! /.mail!] + sent?))) + + (in (do async.monad + [result (async.future (do io.monad + [counter (/.spawn! /.default 0) + _ (/.poison! counter)] + (/.mail! inc! counter)))] + (_.cover' [/.dead] + (case result + (#try.Success outcome) + false + + (#try.Failure error) + (exception.match? /.dead error))))) (let [die! (: (/.Mail Nat) (function (_ state actor) - (async\wrap (exception.throw ..got_wrecked []))))] - (wrap (do async.monad - [result (async.future (do io.monad - [actor (/.spawn! /.default initial_state) - sent? (/.mail! die! actor) - alive? (/.alive? actor) - obituary (/.obituary actor)] - (wrap (#try.Success [actor sent? alive? obituary]))))] - (_.cover' [/.Obituary /.obituary] - (case result - (^ (#try.Success [actor sent? alive? (#.Some [error state (list single_pending_message)])])) - (and (..mailed? sent?) - (not alive?) - (exception.match? ..got_wrecked error) - (n.= initial_state state) - (is? die! single_pending_message)) - - _ - false))))) - - (wrap (do async.monad - [counter (async.future (/.spawn! ..counter 0)) - result (do (try.with async.monad) - [output_1 (/.tell! (count! 1) counter) - output_2 (/.tell! (count! 1) counter) - output_3 (/.tell! (count! 1) counter)] - (wrap (and (n.= 1 output_1) - (n.= 2 output_2) - (n.= 3 output_3))))] - (_.cover' [/.Message /.actor: /.message: /.tell!] + (async\in (exception.except ..got_wrecked []))))] + (in (do async.monad + [result (async.future (do io.monad + [actor (/.spawn! /.default initial_state) + sent? (/.mail! die! actor) + alive? (/.alive? actor) + obituary (/.obituary actor)] + (in (#try.Success [actor sent? alive? obituary]))))] + (_.cover' [/.Obituary /.obituary] (case result - (#try.Success outcome) - outcome - - (#try.Failure error) - false)))) - - (wrap (do async.monad - [verdict (async.future - (do io.monad - [anonymous (/.actor {Nat - initial_state} - ((on_mail message state self) - (message (inc state) self))) - sent/inc? (/.mail! inc! anonymous) - sent/dec? (/.mail! dec! anonymous) - poisoned? (/.poison! anonymous) - obituary (/.obituary anonymous)] - (wrap (and (..mailed? sent/inc?) - (..mailed? sent/dec?) - (..mailed? poisoned?) - (case obituary - (^ (#.Some [error final_state (list poison_pill)])) - (and (exception.match? /.poisoned error) - (n.= (inc (inc initial_state)) - final_state)) - - _ - false)))))] - (_.cover' [/.actor] - verdict))) + (^ (#try.Success [actor sent? alive? (#.Some [error state (list single_pending_message)])])) + (and (..mailed? sent?) + (not alive?) + (exception.match? ..got_wrecked error) + (n.= initial_state state) + (is? die! single_pending_message)) + + _ + false))))) + + (in (do async.monad + [counter (async.future (/.spawn! ..counter 0)) + result (do (try.with async.monad) + [output_1 (/.tell! (count! 1) counter) + output_2 (/.tell! (count! 1) counter) + output_3 (/.tell! (count! 1) counter)] + (in (and (n.= 1 output_1) + (n.= 2 output_2) + (n.= 3 output_3))))] + (_.cover' [/.Message /.actor: /.message: /.tell!] + (case result + (#try.Success outcome) + outcome + + (#try.Failure error) + false)))) + + (in (do async.monad + [verdict (async.future + (do io.monad + [anonymous (/.actor {Nat + initial_state} + ((on_mail message state self) + (message (inc state) self))) + sent/inc? (/.mail! inc! anonymous) + sent/dec? (/.mail! dec! anonymous) + poisoned? (/.poison! anonymous) + obituary (/.obituary anonymous)] + (in (and (..mailed? sent/inc?) + (..mailed? sent/dec?) + (..mailed? poisoned?) + (case obituary + (^ (#.Some [error final_state (list poison_pill)])) + (and (exception.match? /.poisoned error) + (n.= (inc (inc initial_state)) + final_state)) + + _ + false)))))] + (_.cover' [/.actor] + verdict))) (do ! [num_events (\ ! map (|>> (n.% 10) inc) random.nat) @@ -204,25 +204,25 @@ #let [expected (list.take num_observations events) sink (: (Atom (Row Nat)) (atom.atom row.empty))]] - (wrap (do async.monad - [agent (async.future - (do {! io.monad} - [agent (/.actor {Nat 0}) - _ (/.observe (function (_ event stop) - (function (_ events_seen self) - (async.future - (if (n.< num_observations events_seen) - (do ! - [_ (atom.update (row.add event) sink)] - (wrap (#try.Success (inc events_seen)))) - (do ! - [_ stop] - (wrap (#try.Failure "YOLO"))))))) - (frp.sequential 0 events) - agent)] - (wrap agent))) - _ (/.await agent) - actual (async.future (atom.read sink))] - (_.cover' [/.Stop /.observe /.await] - (\ (list.equivalence n.equivalence) = expected (row.to_list actual)))))) + (in (do async.monad + [agent (async.future + (do {! io.monad} + [agent (/.actor {Nat 0}) + _ (/.observe (function (_ event stop) + (function (_ events_seen self) + (async.future + (if (n.< num_observations events_seen) + (do ! + [_ (atom.update (row.add event) sink)] + (in (#try.Success (inc events_seen)))) + (do ! + [_ stop] + (in (#try.Failure "YOLO"))))))) + (frp.sequential 0 events) + agent)] + (in agent))) + _ (/.await agent) + actual (async.future (atom.read sink))] + (_.cover' [/.Stop /.observe /.await] + (\ (list.equivalence n.equivalence) = expected (row.to_list actual)))))) )))) diff --git a/stdlib/source/test/lux/control/concurrency/async.lux b/stdlib/source/test/lux/control/concurrency/async.lux index 1c7d075f4..5a92f595a 100644 --- a/stdlib/source/test/lux/control/concurrency/async.lux +++ b/stdlib/source/test/lux/control/concurrency/async.lux @@ -37,13 +37,13 @@ (do io.monad [?left (/.poll left) ?right (/.poll right)] - (wrap (case [?left ?right] - [(#.Some left) - (#.Some right)] - (== left right) - - _ - false)))))) + (in (case [?left ?right] + [(#.Some left) + (#.Some right)] + (== left right) + + _ + false)))))) (def: delay (for {@.js @@ -68,109 +68,109 @@ (_.for [/.monad] ($monad.spec ..injection ..comparison /.monad)) - (wrap (do /.monad - [#let [[async resolver] (: [(/.Async Nat) (/.Resolver Nat)] - (/.async []))] - resolved? (/.future (resolver expected)) - actual async] - (_.cover' [/.Async /.Resolver /.async] - (and resolved? - (n.= expected actual))))) - (wrap (do /.monad - [actual (/.resolved expected)] - (_.cover' [/.resolved] - (n.= expected actual)))) - (wrap (do /.monad - [actual (/.future (io.io expected))] - (_.cover' [/.future] - (n.= expected actual)))) - (wrap (do /.monad - [pre (/.future instant.now) - actual (/.schedule to_wait (io.io expected)) - post (/.future instant.now)] - (_.cover' [/.schedule] - (and (n.= expected actual) - (i.>= (.int to_wait) - (duration.to_millis (instant.span pre post))))))) - (wrap (do /.monad - [pre (/.future instant.now) - _ (/.wait to_wait) - post (/.future instant.now)] - (_.cover' [/.wait] - (i.>= (.int to_wait) - (duration.to_millis (instant.span pre post)))))) - (wrap (do /.monad - [[leftA rightA] (/.and (/.future (io.io leftE)) - (/.future (io.io rightE)))] - (_.cover' [/.and] + (in (do /.monad + [#let [[async resolver] (: [(/.Async Nat) (/.Resolver Nat)] + (/.async []))] + resolved? (/.future (resolver expected)) + actual async] + (_.cover' [/.Async /.Resolver /.async] + (and resolved? + (n.= expected actual))))) + (in (do /.monad + [actual (/.resolved expected)] + (_.cover' [/.resolved] + (n.= expected actual)))) + (in (do /.monad + [actual (/.future (io.io expected))] + (_.cover' [/.future] + (n.= expected actual)))) + (in (do /.monad + [pre (/.future instant.now) + actual (/.schedule to_wait (io.io expected)) + post (/.future instant.now)] + (_.cover' [/.schedule] + (and (n.= expected actual) + (i.>= (.int to_wait) + (duration.to_millis (instant.span pre post))))))) + (in (do /.monad + [pre (/.future instant.now) + _ (/.wait to_wait) + post (/.future instant.now)] + (_.cover' [/.wait] + (i.>= (.int to_wait) + (duration.to_millis (instant.span pre post)))))) + (in (do /.monad + [[leftA rightA] (/.and (/.future (io.io leftE)) + (/.future (io.io rightE)))] + (_.cover' [/.and] + (n.= (n.+ leftE rightE) + (n.+ leftA rightA))))) + (in (do /.monad + [pre (/.future instant.now) + actual (/.delay to_wait expected) + post (/.future instant.now)] + (_.cover' [/.delay] + (and (n.= expected actual) + (i.>= (.int to_wait) + (duration.to_millis (instant.span pre post))))))) + (in (do /.monad + [?left (/.or (in leftE) + (/.delay to_wait dummy)) + ?right (/.or (/.delay to_wait dummy) + (in rightE))] + (_.cover' [/.or] + (case [?left ?right] + [(#.Left leftA) (#.Right rightA)] (n.= (n.+ leftE rightE) - (n.+ leftA rightA))))) - (wrap (do /.monad - [pre (/.future instant.now) - actual (/.delay to_wait expected) - post (/.future instant.now)] - (_.cover' [/.delay] - (and (n.= expected actual) - (i.>= (.int to_wait) - (duration.to_millis (instant.span pre post))))))) - (wrap (do /.monad - [?left (/.or (wrap leftE) - (/.delay to_wait dummy)) - ?right (/.or (/.delay to_wait dummy) - (wrap rightE))] - (_.cover' [/.or] - (case [?left ?right] - [(#.Left leftA) (#.Right rightA)] - (n.= (n.+ leftE rightE) - (n.+ leftA rightA)) + (n.+ leftA rightA)) - _ - false)))) - (wrap (do /.monad - [leftA (/.either (wrap leftE) - (/.delay to_wait dummy)) - rightA (/.either (/.delay to_wait dummy) - (wrap rightE))] - (_.cover' [/.either] - (n.= (n.+ leftE rightE) - (n.+ leftA rightA))))) - (wrap (do /.monad - [?actual (/.future (/.poll (/.resolved expected))) - #let [[async resolver] (: [(/.Async Nat) (/.Resolver Nat)] - (/.async []))] - ?never (/.future (/.poll async))] - (_.cover' [/.poll] - (case [?actual ?never] - [(#.Some actual) #.None] - (n.= expected actual) + _ + false)))) + (in (do /.monad + [leftA (/.either (in leftE) + (/.delay to_wait dummy)) + rightA (/.either (/.delay to_wait dummy) + (in rightE))] + (_.cover' [/.either] + (n.= (n.+ leftE rightE) + (n.+ leftA rightA))))) + (in (do /.monad + [?actual (/.future (/.poll (/.resolved expected))) + #let [[async resolver] (: [(/.Async Nat) (/.Resolver Nat)] + (/.async []))] + ?never (/.future (/.poll async))] + (_.cover' [/.poll] + (case [?actual ?never] + [(#.Some actual) #.None] + (n.= expected actual) - _ - false)))) - (wrap (do /.monad - [yep (/.future (/.resolved? (/.resolved expected))) - #let [[async resolver] (: [(/.Async Nat) (/.Resolver Nat)] - (/.async []))] - nope (/.future (/.resolved? async))] - (_.cover' [/.resolved?] - (and yep - (not nope))))) - (wrap (do /.monad - [?none (/.time_out 0 (/.delay to_wait dummy)) - ?actual (/.time_out to_wait (wrap expected))] - (_.cover' [/.time_out] - (case [?none ?actual] - [#.None (#.Some actual)] - (n.= expected actual) + _ + false)))) + (in (do /.monad + [yep (/.future (/.resolved? (/.resolved expected))) + #let [[async resolver] (: [(/.Async Nat) (/.Resolver Nat)] + (/.async []))] + nope (/.future (/.resolved? async))] + (_.cover' [/.resolved?] + (and yep + (not nope))))) + (in (do /.monad + [?none (/.time_out 0 (/.delay to_wait dummy)) + ?actual (/.time_out to_wait (in expected))] + (_.cover' [/.time_out] + (case [?none ?actual] + [#.None (#.Some actual)] + (n.= expected actual) - _ - false)))) - (wrap (do /.monad - [#let [box (: (Atom Nat) - (atom.atom dummy))] - _ (/.future (/.await (function (_ value) - (atom.write value box)) - (/.resolved expected))) - actual (/.future (atom.read box))] - (_.cover' [/.await] - (n.= expected actual)))) + _ + false)))) + (in (do /.monad + [#let [box (: (Atom Nat) + (atom.atom dummy))] + _ (/.future (/.await (function (_ value) + (atom.write value box)) + (/.resolved expected))) + actual (/.future (atom.read box))] + (_.cover' [/.await] + (n.= expected actual)))) )))) diff --git a/stdlib/source/test/lux/control/concurrency/atom.lux b/stdlib/source/test/lux/control/concurrency/atom.lux index 567f1c40a..d51af0737 100644 --- a/stdlib/source/test/lux/control/concurrency/atom.lux +++ b/stdlib/source/test/lux/control/concurrency/atom.lux @@ -24,7 +24,7 @@ (io.run (do io.monad [actual (/.read box)] - (wrap (is? expected actual)))))) + (in (is? expected actual)))))) (do random.monad [target random.nat unknown (random.only (|>> (is? target) not) random.nat) @@ -36,9 +36,9 @@ [swapped_unknown? (/.compare_and_swap unknown expected box) swapped_target? (/.compare_and_swap target expected box) actual (/.read box)] - (wrap (and (not swapped_unknown?) - swapped_target? - (is? expected actual))))))) + (in (and (not swapped_unknown?) + swapped_target? + (is? expected actual))))))) (do random.monad [init random.nat shift random.nat @@ -47,9 +47,9 @@ (io.run (do io.monad [[pre post] (/.update (n.+ shift) box)] - (wrap (and (is? init pre) - (n.= (n.+ shift init) - post))))))) + (in (and (is? init pre) + (n.= (n.+ shift init) + post))))))) (do random.monad [pre random.nat post random.nat @@ -59,6 +59,6 @@ (do io.monad [old (/.write post box) new (/.read box)] - (wrap (and (is? pre old) - (is? post new))))))) + (in (and (is? pre old) + (is? post new))))))) ))) diff --git a/stdlib/source/test/lux/control/concurrency/frp.lux b/stdlib/source/test/lux/control/concurrency/frp.lux index e9eabb5bc..5c555ebfc 100644 --- a/stdlib/source/test/lux/control/concurrency/frp.lux +++ b/stdlib/source/test/lux/control/concurrency/frp.lux @@ -38,25 +38,25 @@ (do io.monad [?left (async.poll left) ?right (async.poll right)] - (wrap (case [?left ?right] - [(#.Some (#.Some [left _])) - (#.Some (#.Some [right _]))] - (== left right) - - _ - false)))))) + (in (case [?left ?right] + [(#.Some (#.Some [left _])) + (#.Some (#.Some [right _]))] + (== left right) + + _ + false)))))) (def: (take_amount amount_of_polls [channel sink]) (All [a] (-> Nat [(/.Channel a) (/.Sink a)] (Async (List a)))) (case amount_of_polls 0 (do async.monad [_ (async.future (\ sink close))] - (wrap #.Nil)) + (in #.Nil)) _ (do {! async.monad} [event channel] (case event #.None - (wrap #.Nil) + (in #.Nil) (#.Some [head tail]) (\ ! map (|>> (#.Cons head)) @@ -89,17 +89,17 @@ [#let [[channel sink] (/.channel [])] _ (\ sink feed sample) _ (\ sink close)] - (wrap channel))) + (in channel))) (#try.Success channel) (io.run (do io.monad [?actual (async.poll channel)] - (wrap (case ?actual - (#.Some (#.Some [actual _])) - (n.= sample actual) - - _ - false)))) + (in (case ?actual + (#.Some (#.Some [actual _])) + (n.= sample actual) + + _ + false)))) (#try.Failure error) false)) @@ -114,110 +114,110 @@ (#try.Failure error) (exception.match? /.channel_is_already_closed error))) - (wrap (do async.monad - [output (|> sample - async.resolved - /.of_async - /.consume)] - (_.cover' [/.of_async /.consume] - (list\= (list sample) - output)))) - (wrap (do async.monad - [output (|> inputs - (/.sequential 0) - /.consume)] - (_.cover' [/.sequential] - (list\= inputs - output)))) - (wrap (do async.monad - [output (|> inputs - (/.sequential 0) - (/.only n.even?) - /.consume)] - (_.cover' [/.only] - (list\= (list.only n.even? inputs) - output)))) - (wrap (do {! async.monad} - [#let [[?signal !signal] (: [(async.Async Any) (async.Resolver Any)] - (async.async [])) - sink (: (Atom (Row Nat)) - (atom.atom row.empty))] - _ (async.future (/.subscribe (function (_ value) - (do {! io.monad} - [current (atom.read sink) - _ (atom.update (row.add value) sink)] - (if (n.< (list.size inputs) - (inc (row.size current))) - (wrap (#.Some [])) - (do ! - [_ (!signal [])] - (wrap #.None))))) - (/.sequential 0 (list\compose inputs inputs)))) - _ ?signal - listened (|> sink - atom.read - async.future - (\ ! map row.to_list))] - (_.cover' [/.Subscriber /.subscribe] - (list\= inputs listened)))) - (wrap (do async.monad - [actual (/.fold (function (_ input total) - (async.resolved (n.+ input total))) - 0 - (/.sequential 0 inputs))] - (_.cover' [/.fold] - (n.= (list\fold n.+ 0 inputs) - actual)))) - (wrap (do async.monad - [actual (|> inputs - (/.sequential 0) - (/.folds (function (_ input total) - (async.resolved (n.+ input total))) - 0) - /.consume)] - (_.cover' [/.folds] - (list\= (list.folds n.+ 0 inputs) - actual)))) - (wrap (do async.monad - [actual (|> (list distint/0 distint/0 distint/0 - distint/1 - distint/2 distint/2) - (/.sequential 0) - (/.distinct n.equivalence) - /.consume)] - (_.cover' [/.distinct] - (list\= (list distint/0 distint/1 distint/2) - actual)))) + (in (do async.monad + [output (|> sample + async.resolved + /.of_async + /.consume)] + (_.cover' [/.of_async /.consume] + (list\= (list sample) + output)))) + (in (do async.monad + [output (|> inputs + (/.sequential 0) + /.consume)] + (_.cover' [/.sequential] + (list\= inputs + output)))) + (in (do async.monad + [output (|> inputs + (/.sequential 0) + (/.only n.even?) + /.consume)] + (_.cover' [/.only] + (list\= (list.only n.even? inputs) + output)))) + (in (do {! async.monad} + [#let [[?signal !signal] (: [(async.Async Any) (async.Resolver Any)] + (async.async [])) + sink (: (Atom (Row Nat)) + (atom.atom row.empty))] + _ (async.future (/.subscribe (function (_ value) + (do {! io.monad} + [current (atom.read sink) + _ (atom.update (row.add value) sink)] + (if (n.< (list.size inputs) + (inc (row.size current))) + (in (#.Some [])) + (do ! + [_ (!signal [])] + (in #.None))))) + (/.sequential 0 (list\compose inputs inputs)))) + _ ?signal + listened (|> sink + atom.read + async.future + (\ ! map row.to_list))] + (_.cover' [/.Subscriber /.subscribe] + (list\= inputs listened)))) + (in (do async.monad + [actual (/.fold (function (_ input total) + (async.resolved (n.+ input total))) + 0 + (/.sequential 0 inputs))] + (_.cover' [/.fold] + (n.= (list\fold n.+ 0 inputs) + actual)))) + (in (do async.monad + [actual (|> inputs + (/.sequential 0) + (/.folds (function (_ input total) + (async.resolved (n.+ input total))) + 0) + /.consume)] + (_.cover' [/.folds] + (list\= (list.folds n.+ 0 inputs) + actual)))) + (in (do async.monad + [actual (|> (list distint/0 distint/0 distint/0 + distint/1 + distint/2 distint/2) + (/.sequential 0) + (/.distinct n.equivalence) + /.consume)] + (_.cover' [/.distinct] + (list\= (list distint/0 distint/1 distint/2) + actual)))) (do ! [polling_delay (\ ! map (|>> (n.% 10) inc) random.nat) amount_of_polls (\ ! map (|>> (n.% 10) inc) random.nat)] ($_ _.and - (wrap (do {! async.monad} - [actual (..take_amount amount_of_polls (/.poll polling_delay (: (IO Nat) (io.io sample)))) - #let [correct_values! - (list.every? (n.= sample) actual) - - enough_polls! - (n.= amount_of_polls (list.size actual))]] - (_.cover' [/.poll] - (and correct_values! - enough_polls!)))) - (wrap (do {! async.monad} - [actual (..take_amount amount_of_polls (/.periodic polling_delay))] - (_.cover' [/.periodic] - (n.= amount_of_polls (list.size actual))))))) - (wrap (do async.monad - [#let [max_iterations 10] - actual (|> [0 sample] - (/.iterate (function (_ [iterations current]) - (async.resolved - (if (n.< max_iterations iterations) - (#.Some [[(inc iterations) (n.+ shift current)] - current]) - #.None)))) - /.consume)] - (_.cover' [/.iterate] - (and (n.= max_iterations (list.size actual)) - (list\= (list.folds n.+ sample (list.repeat (dec max_iterations) shift)) - actual))))) + (in (do {! async.monad} + [actual (..take_amount amount_of_polls (/.poll polling_delay (: (IO Nat) (io.io sample)))) + #let [correct_values! + (list.every? (n.= sample) actual) + + enough_polls! + (n.= amount_of_polls (list.size actual))]] + (_.cover' [/.poll] + (and correct_values! + enough_polls!)))) + (in (do {! async.monad} + [actual (..take_amount amount_of_polls (/.periodic polling_delay))] + (_.cover' [/.periodic] + (n.= amount_of_polls (list.size actual))))))) + (in (do async.monad + [#let [max_iterations 10] + actual (|> [0 sample] + (/.iterate (function (_ [iterations current]) + (async.resolved + (if (n.< max_iterations iterations) + (#.Some [[(inc iterations) (n.+ shift current)] + current]) + #.None)))) + /.consume)] + (_.cover' [/.iterate] + (and (n.= max_iterations (list.size actual)) + (list\= (list.folds n.+ sample (list.repeat (dec max_iterations) shift)) + actual))))) ))))) diff --git a/stdlib/source/test/lux/control/concurrency/semaphore.lux b/stdlib/source/test/lux/control/concurrency/semaphore.lux index d1077ae53..1e6dd9a48 100644 --- a/stdlib/source/test/lux/control/concurrency/semaphore.lux +++ b/stdlib/source/test/lux/control/concurrency/semaphore.lux @@ -41,56 +41,56 @@ (do {! random.monad} [initial_open_positions (|> random.nat (\ ! map (|>> (n.% 10) (n.max 1)))) #let [semaphore (/.semaphore initial_open_positions)]] - (wrap (do async.monad - [result (async.time_out ..delay (/.wait semaphore))] - (_.cover' [/.semaphore] - (case result - (#.Some _) - true + (in (do async.monad + [result (async.time_out ..delay (/.wait semaphore))] + (_.cover' [/.semaphore] + (case result + (#.Some _) + true - #.None - false))))) + #.None + false))))) (do {! random.monad} [initial_open_positions (|> random.nat (\ ! map (|>> (n.% 10) (n.max 1)))) #let [semaphore (/.semaphore initial_open_positions)]] - (wrap (do {! async.monad} - [_ (monad.map ! /.wait (list.repeat initial_open_positions semaphore)) - result (async.time_out ..delay (/.wait semaphore))] - (_.cover' [/.wait] - (case result - (#.Some _) - false + (in (do {! async.monad} + [_ (monad.map ! /.wait (list.repeat initial_open_positions semaphore)) + result (async.time_out ..delay (/.wait semaphore))] + (_.cover' [/.wait] + (case result + (#.Some _) + false - #.None - true))))) + #.None + true))))) (do {! random.monad} [initial_open_positions (|> random.nat (\ ! map (|>> (n.% 10) (n.max 1)))) #let [semaphore (/.semaphore initial_open_positions)]] - (wrap (do {! async.monad} - [_ (monad.map ! /.wait (list.repeat initial_open_positions semaphore)) - #let [block (/.wait semaphore)] - result/0 (async.time_out ..delay block) - open_positions (/.signal semaphore) - result/1 (async.time_out ..delay block)] - (_.cover' [/.signal] - (case [result/0 result/1 open_positions] - [#.None (#.Some _) (#try.Success +0)] - true + (in (do {! async.monad} + [_ (monad.map ! /.wait (list.repeat initial_open_positions semaphore)) + #let [block (/.wait semaphore)] + result/0 (async.time_out ..delay block) + open_positions (/.signal semaphore) + result/1 (async.time_out ..delay block)] + (_.cover' [/.signal] + (case [result/0 result/1 open_positions] + [#.None (#.Some _) (#try.Success +0)] + true - _ - false))))) + _ + false))))) (do {! random.monad} [initial_open_positions (|> random.nat (\ ! map (|>> (n.% 10) (n.max 1)))) #let [semaphore (/.semaphore initial_open_positions)]] - (wrap (do async.monad - [outcome (/.signal semaphore)] - (_.cover' [/.semaphore_is_maxed_out] - (case outcome - (#try.Failure error) - (exception.match? /.semaphore_is_maxed_out error) + (in (do async.monad + [outcome (/.signal semaphore)] + (_.cover' [/.semaphore_is_maxed_out] + (case outcome + (#try.Failure error) + (exception.match? /.semaphore_is_maxed_out error) - _ - false))))) + _ + false))))) ))) (def: mutex @@ -110,7 +110,7 @@ [_ (<| (monad.seq !) (list.repeat repetitions) (atom.update (|>> (format "A")) resource))] - (wrap []))) + (in []))) processB (<| (/.synchronize mutex) io.io async.future @@ -118,16 +118,16 @@ [_ (<| (monad.seq !) (list.repeat repetitions) (atom.update (|>> (format "B")) resource))] - (wrap [])))]] - (wrap (do async.monad - [_ processA - _ processB - #let [outcome (io.run (atom.read resource))]] - (_.cover' [/.mutex /.synchronize] - (or (text\= (format expected_As expected_Bs) - outcome) - (text\= (format expected_Bs expected_As) - outcome)))))) + (in [])))]] + (in (do async.monad + [_ processA + _ processB + #let [outcome (io.run (atom.read resource))]] + (_.cover' [/.mutex /.synchronize] + (or (text\= (format expected_As expected_Bs) + outcome) + (text\= (format expected_Bs expected_As) + outcome)))))) ))) (def: (waiter resource barrier id) @@ -135,7 +135,7 @@ (do async.monad [_ (/.block barrier) _ (async.future (atom.update (|>> (format (%.nat id))) resource))] - (wrap []))) + (in []))) (def: barrier Test @@ -158,23 +158,23 @@ [limit (\ ! map (|>> (n.% 9) inc) random.nat) #let [barrier (/.barrier (maybe.assume (/.limit limit))) resource (atom.atom "")]] - (wrap (do {! async.monad} - [#let [suffix "_" - expected_ending (|> suffix - (list.repeat limit) - (text.join_with "")) - expected_ids (enum.range n.enum 0 (dec limit))] - _ (|> expected_ids - (list\map (function (_ id) - (exec (io.run (atom.update (|>> (format suffix)) resource)) - (waiter resource barrier id)))) - (monad.seq !)) - #let [outcome (io.run (atom.read resource))]] - (_.cover' [/.barrier /.block] - (and (text.ends_with? expected_ending outcome) - (list.every? (function (_ id) - (text.contains? (%.nat id) outcome)) - expected_ids)))))) + (in (do {! async.monad} + [#let [suffix "_" + expected_ending (|> suffix + (list.repeat limit) + (text.join_with "")) + expected_ids (enum.range n.enum 0 (dec limit))] + _ (|> expected_ids + (list\map (function (_ id) + (exec (io.run (atom.update (|>> (format suffix)) resource)) + (waiter resource barrier id)))) + (monad.seq !)) + #let [outcome (io.run (atom.read resource))]] + (_.cover' [/.barrier /.block] + (and (text.ends_with? expected_ending outcome) + (list.every? (function (_ id) + (text.contains? (%.nat id) outcome)) + expected_ids)))))) ))) (def: #export test diff --git a/stdlib/source/test/lux/control/concurrency/stm.lux b/stdlib/source/test/lux/control/concurrency/stm.lux index 053cc7dd8..67d73d61e 100644 --- a/stdlib/source/test/lux/control/concurrency/stm.lux +++ b/stdlib/source/test/lux/control/concurrency/stm.lux @@ -27,7 +27,7 @@ (def: injection (Injection /.STM) - (\ /.monad wrap)) + (\ /.monad in)) (def: comparison (Comparison /.STM) @@ -50,54 +50,54 @@ (_.for [/.monad] ($monad.spec ..injection ..comparison /.monad)) - (wrap (do async.monad - [actual (/.commit (\ /.monad wrap expected))] - (_.cover' [/.commit] - (n.= expected actual)))) - (wrap (do async.monad - [actual (/.commit (/.read (/.var expected)))] - (_.cover' [/.Var /.var /.read] - (n.= expected actual)))) - (wrap (do async.monad - [actual (let [box (/.var dummy)] - (/.commit (do /.monad - [_ (/.write expected box)] - (/.read box)))) - verdict (let [box (/.var dummy)] - (/.commit (do /.monad - [_ (/.write expected box) - actual (/.read box)] - (wrap (n.= expected actual)))))] - (_.cover' [/.write] - (and (n.= expected actual) - verdict)))) - (wrap (do async.monad - [#let [box (/.var dummy)] - output (/.commit (do /.monad - [_ (/.update (n.+ expected) box)] - (/.read box)))] - (_.cover' [/.update] - (n.= (n.+ expected dummy) - output)))) - (wrap (do async.monad - [#let [box (/.var dummy) - [follower sink] (io.run (/.follow box))] - _ (/.commit (/.write expected box)) - _ (/.commit (/.update (n.* 2) box)) - _ (async.future (\ sink close)) - _ (/.commit (/.update (n.* 3) box)) - changes (frp.consume follower)] - (_.cover' [/.follow] - (\ (list.equivalence n.equivalence) = - (list expected (n.* 2 expected)) - changes)))) - (wrap (let [var (/.var 0)] - (do {! async.monad} - [_ (|> (list.repeat iterations_per_process []) - (list\map (function (_ _) (/.commit (/.update inc var)))) - (monad.seq !)) - cummulative (/.commit (/.read var))] - (_.cover' [/.STM] - (n.= iterations_per_process - cummulative))))) + (in (do async.monad + [actual (/.commit (\ /.monad in expected))] + (_.cover' [/.commit] + (n.= expected actual)))) + (in (do async.monad + [actual (/.commit (/.read (/.var expected)))] + (_.cover' [/.Var /.var /.read] + (n.= expected actual)))) + (in (do async.monad + [actual (let [box (/.var dummy)] + (/.commit (do /.monad + [_ (/.write expected box)] + (/.read box)))) + verdict (let [box (/.var dummy)] + (/.commit (do /.monad + [_ (/.write expected box) + actual (/.read box)] + (in (n.= expected actual)))))] + (_.cover' [/.write] + (and (n.= expected actual) + verdict)))) + (in (do async.monad + [#let [box (/.var dummy)] + output (/.commit (do /.monad + [_ (/.update (n.+ expected) box)] + (/.read box)))] + (_.cover' [/.update] + (n.= (n.+ expected dummy) + output)))) + (in (do async.monad + [#let [box (/.var dummy) + [follower sink] (io.run (/.follow box))] + _ (/.commit (/.write expected box)) + _ (/.commit (/.update (n.* 2) box)) + _ (async.future (\ sink close)) + _ (/.commit (/.update (n.* 3) box)) + changes (frp.consume follower)] + (_.cover' [/.follow] + (\ (list.equivalence n.equivalence) = + (list expected (n.* 2 expected)) + changes)))) + (in (let [var (/.var 0)] + (do {! async.monad} + [_ (|> (list.repeat iterations_per_process []) + (list\map (function (_ _) (/.commit (/.update inc var)))) + (monad.seq !)) + cummulative (/.commit (/.read var))] + (_.cover' [/.STM] + (n.= iterations_per_process + cummulative))))) )))) diff --git a/stdlib/source/test/lux/control/concurrency/thread.lux b/stdlib/source/test/lux/control/concurrency/thread.lux index cb4e7d889..0758f48b3 100644 --- a/stdlib/source/test/lux/control/concurrency/thread.lux +++ b/stdlib/source/test/lux/control/concurrency/thread.lux @@ -31,22 +31,22 @@ ($_ _.and (_.cover [/.parallelism] (n.> 0 /.parallelism)) - (wrap (do async.monad - [reference_time (async.future instant.now) - #let [box (atom.atom [reference_time dummy])] - _ (async.future - (/.schedule delay (do io.monad - [execution_time instant.now] - (atom.write [execution_time expected] box)))) - _ (async.wait (n.* 2 delay)) - [execution_time actual] (async.future (atom.read box))] - (_.cover' [/.schedule] - (let [expected_delay! - (i.>= (.int delay) - (duration.to_millis (instant.span reference_time execution_time))) + (in (do async.monad + [reference_time (async.future instant.now) + #let [box (atom.atom [reference_time dummy])] + _ (async.future + (/.schedule delay (do io.monad + [execution_time instant.now] + (atom.write [execution_time expected] box)))) + _ (async.wait (n.* 2 delay)) + [execution_time actual] (async.future (atom.read box))] + (_.cover' [/.schedule] + (let [expected_delay! + (i.>= (.int delay) + (duration.to_millis (instant.span reference_time execution_time))) - correct_value! - (n.= expected actual)] - (and expected_delay! - correct_value!))))) + correct_value! + (n.= expected actual)] + (and expected_delay! + correct_value!))))) )))) diff --git a/stdlib/source/test/lux/control/continuation.lux b/stdlib/source/test/lux/control/continuation.lux index d13a3ee78..24944c49e 100644 --- a/stdlib/source/test/lux/control/continuation.lux +++ b/stdlib/source/test/lux/control/continuation.lux @@ -45,7 +45,7 @@ ($monad.spec ..injection ..comparison /.monad)) (_.cover [/.run] - (n.= sample (/.run (_\wrap sample)))) + (n.= sample (/.run (_\in sample)))) (_.cover [/.call/cc] (n.= (n.* 2 sample) (/.run (do {! /.monad} @@ -57,14 +57,14 @@ ## the output would be ## (n.* 4 sample) (k temp))))] - (wrap (n.* 2 value)))))) + (in (n.* 2 value)))))) (_.cover [/.portal] (n.= (n.+ 100 sample) (/.run (do /.monad [[restart [output idx]] (/.portal [sample 0])] (if (n.< 10 idx) (restart [(n.+ 10 output) (inc idx)]) - (wrap output)))))) + (in output)))))) (_.cover [/.shift /.reset] (let [(^open "_\.") /.monad (^open "list\.") (list.equivalence n.equivalence) @@ -73,14 +73,14 @@ (function (visit xs) (case xs #.Nil - (_\wrap #.Nil) + (_\in #.Nil) (#.Cons x xs') (do {! /.monad} [output (/.shift (function (_ k) (do ! [tail (k xs')] - (wrap (#.Cons x tail)))))] + (in (#.Cons x tail)))))] (visit output)))))] (list\= elems (/.run (/.reset (visit elems)))))) diff --git a/stdlib/source/test/lux/control/exception.lux b/stdlib/source/test/lux/control/exception.lux index 21d81f014..1ab4cf0e5 100644 --- a/stdlib/source/test/lux/control/exception.lux +++ b/stdlib/source/test/lux/control/exception.lux @@ -41,12 +41,12 @@ (case (/.return expected) (#try.Success actual) (n.= expected actual) (#try.Failure _) false)) - (_.cover [/.throw] - (case (/.throw ..an_exception []) + (_.cover [/.except] + (case (/.except ..an_exception []) (#try.Success _) false (#try.Failure _) true)) (_.cover [/.construct] - (case (/.throw ..an_exception []) + (case (/.except ..an_exception []) (#try.Success _) false @@ -65,17 +65,17 @@ (text\= message (/.construct ..an_exception []))))) (_.cover [/.catch] (and (n.= expected - (|> (/.throw ..an_exception []) + (|> (/.except ..an_exception []) (/.catch ..an_exception (function (_ ex) expected)) (/.otherwise (function (_ ex) wrong)))) (n.= expected - (|> (/.throw ..another_exception []) + (|> (/.except ..another_exception []) (/.catch ..an_exception (function (_ ex) wrong)) (/.catch ..another_exception (function (_ ex) expected)) (/.otherwise (function (_ ex) wrong)))))) (_.cover [/.otherwise] (n.= expected - (|> (/.throw ..another_exception []) + (|> (/.except ..another_exception []) (/.catch ..an_exception (function (_ ex) wrong)) (/.otherwise (function (_ ex) expected))))) (_.cover [/.report] @@ -100,7 +100,7 @@ (#try.Failure message) (text\= message (/.construct ..an_exception []))) (case (/.with ..an_exception [] (: (Try Nat) - (/.throw ..another_exception []))) + (/.except ..another_exception []))) (#try.Success _) false @@ -108,7 +108,7 @@ (and (text.contains? (/.construct ..an_exception []) message) (text.contains? (/.construct ..another_exception []) message))))) (_.cover [/.exception:] - (case (/.throw ..custom_exception [expected]) + (case (/.except ..custom_exception [expected]) (#try.Success _) false diff --git a/stdlib/source/test/lux/control/function/memo.lux b/stdlib/source/test/lux/control/function/memo.lux index 29c39dbdb..edc74a9c0 100644 --- a/stdlib/source/test/lux/control/function/memo.lux +++ b/stdlib/source/test/lux/control/function/memo.lux @@ -28,12 +28,12 @@ (def: (fibonacci recur input) (/.Memo Nat Nat) (case input - 0 (state\wrap 0) - 1 (state\wrap 1) + 0 (state\in 0) + 1 (state\in 1) _ (do state.monad [output_1 (recur (n.- 1 input)) output_2 (recur (n.- 2 input))] - (wrap (n.+ output_1 output_2))))) + (in (n.+ output_1 output_2))))) (def: (time function input) (All [i o] (-> (-> i o) i (IO [Duration o]))) @@ -41,8 +41,8 @@ [before instant.now #let [output (function input)] after instant.now] - (wrap [(instant.span before after) - output]))) + (in [(instant.span before after) + output]))) (def: milli_seconds (-> Duration Nat) @@ -75,8 +75,8 @@ memo_is_faster! (n.< (n.+ ..wiggle_room (milli_seconds slow_time)) (milli_seconds fast_time))]] - (wrap (and same_output! - memo_is_faster!))))) + (in (and same_output! + memo_is_faster!))))) (_.cover [/.open] (io.run (do io.monad @@ -97,19 +97,19 @@ incrementalism_is_faster! (n.< (n.+ ..wiggle_room (milli_seconds open_time)) (milli_seconds open_time/+1))]] - (wrap (and same_output! - memo_is_faster! - incrementalism_is_faster!))))) + (in (and same_output! + memo_is_faster! + incrementalism_is_faster!))))) (_.cover [/.memoization] (let [memo (<| //.mixin (//.inherit /.memoization) (: (//.Mixin Nat (State (Dictionary Nat Nat) Nat)) (function (factorial delegate recur input) (case input - (^or 0 1) (\ state.monad wrap 1) + (^or 0 1) (\ state.monad in 1) _ (do state.monad [output' (recur (dec input))] - (wrap (n.* input output'))))))) + (in (n.* input output'))))))) expected (|> (list.indices input) (list\map inc) (list\fold n.* 1)) diff --git a/stdlib/source/test/lux/control/function/mixin.lux b/stdlib/source/test/lux/control/function/mixin.lux index 38ed0f982..1ebf38e79 100644 --- a/stdlib/source/test/lux/control/function/mixin.lux +++ b/stdlib/source/test/lux/control/function/mixin.lux @@ -36,8 +36,8 @@ generator (: (Random (/.Mixin Nat Nat)) (do ! [output random.nat] - (wrap (function (_ delegate recur input) - output)))) + (in (function (_ delegate recur input) + output)))) expected (|> (list.indices input) (list\map inc) (list\fold n.* 1))]]) diff --git a/stdlib/source/test/lux/control/parser.lux b/stdlib/source/test/lux/control/parser.lux index 1fed0e4cb..382d17063 100644 --- a/stdlib/source/test/lux/control/parser.lux +++ b/stdlib/source/test/lux/control/parser.lux @@ -77,12 +77,12 @@ #0)) (syntax: (match pattern then input) - (wrap (list (` (case (~ input) - (^ (#try.Success [(~' _) (~ pattern)])) - (~ then) + (in (list (` (case (~ input) + (^ (#try.Success [(~' _) (~ pattern)])) + (~ then) - (~' _) - #0))))) + (~' _) + #0))))) (def: combinators_0 Test @@ -246,7 +246,7 @@ (list\map code.nat expected+) actual)))) (_.cover [/.default] - (and (|> (/.run (/.default wrong (\ /.monad wrap expected)) (list)) + (and (|> (/.run (/.default wrong (\ /.monad in expected)) (list)) (match actual (n.= expected actual))) (|> (/.run (/.default expected (: (Parser (List Code) Nat) (/.failure "yolo"))) @@ -331,7 +331,7 @@ (def: injection (Injection (All [a i] (Parser i a))) - (\ /.monad wrap)) + (\ /.monad in)) (def: comparison (Comparison (All [a i] (Parser i a))) @@ -360,7 +360,7 @@ ($monad.spec ..injection ..comparison /.monad)) (_.cover [/.run] - (|> (/.run (\ /.monad wrap expected) (list)) + (|> (/.run (\ /.monad in expected) (list)) (match actual (n.= expected actual)))) (_.cover [/.failure] (|> (list) diff --git a/stdlib/source/test/lux/control/parser/analysis.lux b/stdlib/source/test/lux/control/parser/analysis.lux index 8be89e101..b16045572 100644 --- a/stdlib/source/test/lux/control/parser/analysis.lux +++ b/stdlib/source/test/lux/control/parser/analysis.lux @@ -108,7 +108,7 @@ (|> (/.run (do <>.monad [verdict /.end? _ /.bit] - (wrap verdict)) + (in verdict)) (list (analysis.bit dummy))) (!expect (#try.Success #0)))))) (do {! random.monad} diff --git a/stdlib/source/test/lux/control/parser/binary.lux b/stdlib/source/test/lux/control/parser/binary.lux index ebba6bc28..c494562bc 100644 --- a/stdlib/source/test/lux/control/parser/binary.lux +++ b/stdlib/source/test/lux/control/parser/binary.lux @@ -117,10 +117,10 @@ (Random Type) (let [(^open ".") random.monad] ($_ random.either - (wrap .Nat) - (wrap .List) - (wrap .Code) - (wrap .Type)))) + (in .Nat) + (in .List) + (in .Code) + (in .Type)))) (def: size Test @@ -351,8 +351,8 @@ [pre /.end? _ (/.segment ..segment_size) post /.end?] - (wrap (and (not pre) - post)))) + (in (and (not pre) + post)))) (!expect (#try.Success #1))))) (do {! random.monad} [to_read (\ ! map (n.% (inc ..segment_size)) random.nat) @@ -365,9 +365,9 @@ offset /.offset _ (/.segment (n.- to_read ..segment_size)) nothing_left /.offset] - (wrap (and (n.= 0 start) - (n.= to_read offset) - (n.= ..segment_size nothing_left))))) + (in (and (n.= 0 start) + (n.= to_read offset) + (n.= ..segment_size nothing_left))))) (!expect (#try.Success #1))))) (do {! random.monad} [to_read (\ ! map (n.% (inc ..segment_size)) random.nat) @@ -379,9 +379,9 @@ remaining /.remaining _ (/.segment (n.- to_read ..segment_size)) nothing_left /.remaining] - (wrap (and (n.= ..segment_size - (n.+ to_read remaining)) - (n.= 0 nothing_left))))) + (in (and (n.= ..segment_size + (n.+ to_read remaining)) + (n.= 0 nothing_left))))) (!expect (#try.Success #1))))) ..size ..binary diff --git a/stdlib/source/test/lux/control/parser/code.lux b/stdlib/source/test/lux/control/parser/code.lux index 38d915243..a9adeb507 100644 --- a/stdlib/source/test/lux/control/parser/code.lux +++ b/stdlib/source/test/lux/control/parser/code.lux @@ -121,8 +121,8 @@ [pre /.end? _ /.any post /.end?] - (wrap (and (not pre) - post))) + (in (and (not pre) + post))) (list dummy)) (!expect (^multi (#try.Success verdict) verdict))))) diff --git a/stdlib/source/test/lux/control/parser/environment.lux b/stdlib/source/test/lux/control/parser/environment.lux index 68f98ea13..017795418 100644 --- a/stdlib/source/test/lux/control/parser/environment.lux +++ b/stdlib/source/test/lux/control/parser/environment.lux @@ -29,7 +29,7 @@ (do random.monad [expected random.nat] (_.cover [/.run] - (|> (/.run (//\wrap expected) /.empty) + (|> (/.run (//\in expected) /.empty) (\ try.functor map (n.= expected)) (try.default false)))) (do random.monad @@ -43,11 +43,11 @@ (try.default false)))) (do random.monad [property (random.ascii/alpha 1)] - (_.cover [/.unknown] + (_.cover [/.unknown_property] (case (/.run (/.property property) /.empty) (#try.Success _) false (#try.Failure error) - (exception.match? /.unknown error)))) + (exception.match? /.unknown_property error)))) ))) diff --git a/stdlib/source/test/lux/control/parser/text.lux b/stdlib/source/test/lux/control/parser/text.lux index 46e0d4bda..84758e83b 100644 --- a/stdlib/source/test/lux/control/parser/text.lux +++ b/stdlib/source/test/lux/control/parser/text.lux @@ -135,12 +135,12 @@ (..should_fail (text.of_code invalid) /.alpha_num)))) (do {! random.monad} [expected ($_ random.either - (wrap text.tab) - (wrap text.vertical_tab) - (wrap text.space) - (wrap text.new_line) - (wrap text.carriage_return) - (wrap text.form_feed)) + (in text.tab) + (in text.vertical_tab) + (in text.space) + (in text.new_line) + (in text.carriage_return) + (in text.form_feed)) invalid (|> (random.unicode 1) (random.only (function (_ char) (not (or (text\= text.tab char) (text\= text.vertical_tab char) @@ -354,21 +354,21 @@ [pre /.offset _ /.any post /.offset] - (wrap [pre post]))) + (in [pre post]))) (!expect (#try.Success [0 1]))))) (do {! random.monad} [left (random.unicode 1) right (random.unicode 1) #let [input (format left right)]] - (_.cover [/.get_input] + (_.cover [/.remaining] (|> input (/.run (do <>.monad - [pre /.get_input + [pre /.remaining _ /.any - post /.get_input + post /.remaining _ /.any] - (wrap (and (text\= input pre) - (text\= right post))))) + (in (and (text\= input pre) + (text\= right post))))) (!expect (#try.Success #1))))) (do {! random.monad} [left (random.unicode 1) @@ -380,19 +380,19 @@ (/.run (/.enclosed [left right] (/.this expected))) (!expect (#try.Success _))))) (do {! random.monad} - [in (random.unicode 1) - out (random.unicode 1)] + [input (random.unicode 1) + output (random.unicode 1)] (_.cover [/.local] - (|> out + (|> output (/.run (do <>.monad - [_ (/.local in (/.this in))] - (/.this out))) + [_ (/.local input (/.this input))] + (/.this output))) (!expect (#try.Success _))))) (do {! random.monad} [expected (\ ! map (|>> (n.% 8) (\ n.octal encode)) random.nat)] - (_.cover [/.embed] + (_.cover [/.then] (|> (list (code.text expected)) - (<c>.run (/.embed /.octal <c>.text)) + (<c>.run (/.then /.octal <c>.text)) (!expect (^multi (#try.Success actual) (text\= expected actual)))))) (do {! random.monad} diff --git a/stdlib/source/test/lux/control/parser/type.lux b/stdlib/source/test/lux/control/parser/type.lux index 37be6989c..c4c1ed0fa 100644 --- a/stdlib/source/test/lux/control/parser/type.lux +++ b/stdlib/source/test/lux/control/parser/type.lux @@ -202,7 +202,7 @@ (and (|> (/.run (do //.monad [actual /.peek _ /.any] - (wrap actual)) + (in actual)) expected) (!expect (^multi (#try.Success actual) (type\= expected actual)))) @@ -229,7 +229,7 @@ (|> (/.run (do //.monad [env /.env _ /.any] - (wrap env)) + (in env)) expected) (!expect (^multi (#try.Success environment) (is? /.fresh environment)))))) diff --git a/stdlib/source/test/lux/control/parser/xml.lux b/stdlib/source/test/lux/control/parser/xml.lux index 46d80dcc3..a6e7e7c2e 100644 --- a/stdlib/source/test/lux/control/parser/xml.lux +++ b/stdlib/source/test/lux/control/parser/xml.lux @@ -66,7 +66,7 @@ (!expect (^multi (#try.Success actual) (text\= expected actual)))))) (!failure /.unconsumed_inputs - [[(//\wrap expected) + [[(//\in expected) (#xml.Text expected)]]) (do {! random.monad} [expected (random.ascii/alpha 1)] @@ -79,17 +79,17 @@ (|> (/.run (do //.monad [actual /.tag _ /.ignore] - (wrap (name\= expected actual))) + (in (name\= expected actual))) (list (#xml.Node expected (dictionary.new name.hash) (list)))) (!expect (#try.Success #1))))) (do {! random.monad} [expected ..random_tag] (_.cover [/.node] - (|> (/.run (/.node expected (//\wrap [])) + (|> (/.run (/.node expected (//\in [])) (list (#xml.Node expected (dictionary.new name.hash) (list)))) (!expect (#try.Success []))))) (!failure /.wrong_tag - [[(/.node ["" expected] (//\wrap [])) + [[(/.node ["" expected] (//\in [])) (#xml.Node [expected ""] (dictionary.new name.hash) (list))]]) (do {! random.monad} [expected_tag ..random_tag @@ -98,7 +98,7 @@ (_.cover [/.attribute] (|> (/.run (<| (/.node expected_tag) (//.after (/.attribute expected_attribute)) - (//\wrap [])) + (//\in [])) (list (#xml.Node expected_tag (|> (dictionary.new name.hash) (dictionary.put expected_attribute expected_value)) @@ -122,7 +122,7 @@ [(do //.monad [_ /.ignore] (/.node [expected expected] - (//\wrap []))) + (//\in []))) (#xml.Node [expected expected] (dictionary.new name.hash) (list))] @@ -138,7 +138,7 @@ [[/.text (#xml.Node [expected expected] (dictionary.new name.hash) (list))] [(/.node [expected expected] - (//\wrap [])) + (//\in [])) (#xml.Text expected)] [(/.node [expected expected] (/.attribute [expected expected])) @@ -155,9 +155,9 @@ (do //.monad [_ (<| /.somewhere (/.node right) - (//\wrap [])) + (//\in [])) _ (//.some /.ignore)] - (wrap [])))] + (in [])))] repetitions (\ ! map (n.% 10) random.nat)] ($_ _.and (_.cover [/.somewhere] diff --git a/stdlib/source/test/lux/control/reader.lux b/stdlib/source/test/lux/control/reader.lux index 47ddbd8b2..833399ba7 100644 --- a/stdlib/source/test/lux/control/reader.lux +++ b/stdlib/source/test/lux/control/reader.lux @@ -52,9 +52,9 @@ (_.cover [/.with /.lift] (|> (: (/.Reader Any (IO Nat)) (do (/.with io.monad) - [a (/.lift (io\wrap sample)) - b (wrap factor)] - (wrap (n.* b a)))) + [a (/.lift (io\in sample)) + b (in factor)] + (in (n.* b a)))) (/.run []) io.run (n.= (n.* factor sample))))))))) diff --git a/stdlib/source/test/lux/control/region.lux b/stdlib/source/test/lux/control/region.lux index 61e67e81f..9bd903d71 100644 --- a/stdlib/source/test/lux/control/region.lux +++ b/stdlib/source/test/lux/control/region.lux @@ -104,16 +104,16 @@ count_clean_up (function (_ value) (do ! [_ (thread.update inc clean_up_counter)] - (wrap (#try.Success []))))] + (in (#try.Success []))))] outcome (/.run ! (do {! (/.monad !)} [_ (monad.map ! (/.acquire //@ count_clean_up) (enum.range n.enum 1 expected_clean_ups))] - (wrap []))) + (in []))) actual_clean_ups (thread.read clean_up_counter)] - (wrap (and (..success? outcome) - (n.= expected_clean_ups - actual_clean_ups)))))) + (in (and (..success? outcome) + (n.= expected_clean_ups + actual_clean_ups)))))) (_.cover [/.failure] (thread.run (do {! thread.monad} @@ -122,18 +122,18 @@ count_clean_up (function (_ value) (do ! [_ (thread.update inc clean_up_counter)] - (wrap (#try.Success []))))] + (in (#try.Success []))))] outcome (/.run ! (do {! (/.monad !)} [_ (monad.map ! (/.acquire //@ count_clean_up) (enum.range n.enum 1 expected_clean_ups)) _ (/.failure //@ (exception.construct ..oops []))] - (wrap []))) + (in []))) actual_clean_ups (thread.read clean_up_counter)] - (wrap (and (..throws? ..oops outcome) - (n.= expected_clean_ups - actual_clean_ups)))))) - (_.cover [/.throw] + (in (and (..throws? ..oops outcome) + (n.= expected_clean_ups + actual_clean_ups)))))) + (_.cover [/.except] (thread.run (do {! thread.monad} [clean_up_counter (thread.box 0) @@ -141,17 +141,17 @@ count_clean_up (function (_ value) (do ! [_ (thread.update inc clean_up_counter)] - (wrap (#try.Success []))))] + (in (#try.Success []))))] outcome (/.run ! (do {! (/.monad !)} [_ (monad.map ! (/.acquire //@ count_clean_up) (enum.range n.enum 1 expected_clean_ups)) - _ (/.throw //@ ..oops [])] - (wrap []))) + _ (/.except //@ ..oops [])] + (in []))) actual_clean_ups (thread.read clean_up_counter)] - (wrap (and (..throws? ..oops outcome) - (n.= expected_clean_ups - actual_clean_ups)))))) + (in (and (..throws? ..oops outcome) + (n.= expected_clean_ups + actual_clean_ups)))))) (_.cover [/.acquire /.clean_up_error] (thread.run (do {! thread.monad} @@ -160,18 +160,18 @@ count_clean_up (function (_ value) (do ! [_ (thread.update inc clean_up_counter)] - (wrap (: (Try Any) - (exception.throw ..oops [])))))] + (in (: (Try Any) + (exception.except ..oops [])))))] outcome (/.run ! (do {! (/.monad !)} [_ (monad.map ! (/.acquire //@ count_clean_up) (enum.range n.enum 1 expected_clean_ups))] - (wrap []))) + (in []))) actual_clean_ups (thread.read clean_up_counter)] - (wrap (and (or (n.= 0 expected_clean_ups) - (..throws? /.clean_up_error outcome)) - (n.= expected_clean_ups - actual_clean_ups)))))) + (in (and (or (n.= 0 expected_clean_ups) + (..throws? /.clean_up_error outcome)) + (n.= expected_clean_ups + actual_clean_ups)))))) (_.cover [/.lift] (thread.run (do {! thread.monad} @@ -180,9 +180,9 @@ outcome (/.run ! (do (/.monad !) [_ (/.lift //@ (thread.write expected_clean_ups clean_up_counter))] - (wrap []))) + (in []))) actual_clean_ups (thread.read clean_up_counter)] - (wrap (and (..success? outcome) - (n.= expected_clean_ups - actual_clean_ups)))))) + (in (and (..success? outcome) + (n.= expected_clean_ups + actual_clean_ups)))))) )))) diff --git a/stdlib/source/test/lux/control/remember.lux b/stdlib/source/test/lux/control/remember.lux index a96f993c9..5f62bac4b 100644 --- a/stdlib/source/test/lux/control/remember.lux +++ b/stdlib/source/test/lux/control/remember.lux @@ -76,33 +76,33 @@ should_fail1 (..attempt (macro.expand (to_remember macro yesterday message (#.Some expected)))) should_succeed0 (..attempt (macro.expand (to_remember macro tomorrow message #.None))) should_succeed1 (..attempt (macro.expand (to_remember macro tomorrow message (#.Some expected))))] - (wrap (list (code.bit (and (case should_fail0 - (#try.Failure error) - (and (test_failure yesterday message #.None error) - (text.contains? extra error)) + (in (list (code.bit (and (case should_fail0 + (#try.Failure error) + (and (test_failure yesterday message #.None error) + (text.contains? extra error)) - _ - false) - (case should_fail1 - (#try.Failure error) - (and (test_failure yesterday message (#.Some expected) error) - (text.contains? extra error)) + _ + false) + (case should_fail1 + (#try.Failure error) + (and (test_failure yesterday message (#.Some expected) error) + (text.contains? extra error)) - _ - false) - (case should_succeed0 - (^ (#try.Success (list))) - true + _ + false) + (case should_succeed0 + (^ (#try.Success (list))) + true - _ - false) - (case should_succeed1 - (^ (#try.Success (list actual))) - (is? expected actual) + _ + false) + (case should_succeed1 + (^ (#try.Success (list actual))) + (is? expected actual) - _ - false) - ))))))) + _ + false) + ))))))) (def: #export test Test diff --git a/stdlib/source/test/lux/control/security/capability.lux b/stdlib/source/test/lux/control/security/capability.lux index 3547b27b1..008d6e798 100644 --- a/stdlib/source/test/lux/control/security/capability.lux +++ b/stdlib/source/test/lux/control/security/capability.lux @@ -37,9 +37,9 @@ [untouched actual] (/.use capability [pass_through base])] (and (is? pass_through untouched) (n.= expected actual)))) - (wrap (let [capability (..can_io (function (_ _) (io.io expected)))] - (do async.monad - [actual (/.use (/.async capability) [])] - (_.cover' [/.async] - (n.= expected actual))))) + (in (let [capability (..can_io (function (_ _) (io.io expected)))] + (do async.monad + [actual (/.use (/.async capability) [])] + (_.cover' [/.async] + (n.= expected actual))))) ))))) diff --git a/stdlib/source/test/lux/control/security/policy.lux b/stdlib/source/test/lux/control/security/policy.lux index 577439ab5..0f6266635 100644 --- a/stdlib/source/test/lux/control/security/policy.lux +++ b/stdlib/source/test/lux/control/security/policy.lux @@ -30,7 +30,8 @@ (== (can_reveal left) (can_reveal right)))) -(type: Password (Private Text)) +(type: Password + (Private Text)) (interface: (Policy %) (: (Hash (Password %)) diff --git a/stdlib/source/test/lux/control/state.lux b/stdlib/source/test/lux/control/state.lux index a037f8a91..d537ca4de 100644 --- a/stdlib/source/test/lux/control/state.lux +++ b/stdlib/source/test/lux/control/state.lux @@ -85,7 +85,7 @@ [limit (|> random.nat (\ ! map (n.% 10))) #let [condition (do /.monad [state /.get] - (wrap (n.< limit state)))]] + (in (n.< limit state)))]] ($_ _.and (_.cover [/.while /.run] (|> (/.while condition (/.update inc)) @@ -111,9 +111,9 @@ (_.cover [/.State' /.with /.lift /.run'] (|> (: (/.State' io.IO Nat Nat) (do (/.with io.monad) - [a (/.lift io.monad (io\wrap left)) - b (wrap right)] - (wrap (n.+ a b)))) + [a (/.lift io.monad (io\in left)) + b (in right)] + (in (n.+ a b)))) (/.run' state) io.run (let> [state' output'] diff --git a/stdlib/source/test/lux/control/thread.lux b/stdlib/source/test/lux/control/thread.lux index 43d755145..b7af2183f 100644 --- a/stdlib/source/test/lux/control/thread.lux +++ b/stdlib/source/test/lux/control/thread.lux @@ -19,7 +19,7 @@ (def: (injection value) (Injection (All [a !] (Thread ! a))) - (\ /.monad wrap value)) + (\ /.monad in value)) (def: comparison (Comparison (All [a !] (Thread ! a))) @@ -38,12 +38,12 @@ (_.cover [/.run] (n.= sample (|> sample - (\ /.monad wrap) + (\ /.monad in) /.run))) (_.cover [/.io] (n.= sample (|> sample - (\ /.monad wrap) + (\ /.monad in) /.io io.run))) diff --git a/stdlib/source/test/lux/control/try.lux b/stdlib/source/test/lux/control/try.lux index 882864ffd..4fbf42fd2 100644 --- a/stdlib/source/test/lux/control/try.lux +++ b/stdlib/source/test/lux/control/try.lux @@ -82,9 +82,9 @@ (_.cover [/.with /.lifted] (let [lifted (/.lifted io.monad)] (|> (do (/.with io.monad) - [a (lifted (io\wrap expected)) - b (wrap alternative)] - (wrap (n.+ a b))) + [a (lifted (io\in expected)) + b (in alternative)] + (in (n.+ a b))) io.run (case> (#/.Success result) (n.= (n.+ expected alternative) diff --git a/stdlib/source/test/lux/control/writer.lux b/stdlib/source/test/lux/control/writer.lux index 51f2ea36d..ddf6ecc00 100644 --- a/stdlib/source/test/lux/control/writer.lux +++ b/stdlib/source/test/lux/control/writer.lux @@ -54,9 +54,9 @@ (let [lift (/.lift text.monoid io.monad) (^open "io\.") io.monad] (|> (io.run (do (/.with text.monoid io.monad) - [a (lift (io\wrap left)) - b (wrap right)] - (wrap (n.+ a b)))) + [a (lift (io\in left)) + b (in right)] + (in (n.+ a b)))) product.right (n.= (n.+ left right))))) )))) diff --git a/stdlib/source/test/lux/data.lux b/stdlib/source/test/lux/data.lux index 95576f815..8f07c3ad5 100644 --- a/stdlib/source/test/lux/data.lux +++ b/stdlib/source/test/lux/data.lux @@ -29,7 +29,7 @@ (template: (!bundle body) (: Test (do random.monad - [_ (wrap [])] + [_ (in [])] body))) (def: format diff --git a/stdlib/source/test/lux/data/binary.lux b/stdlib/source/test/lux/data/binary.lux index 2a8f519fa..b8775be48 100644 --- a/stdlib/source/test/lux/data/binary.lux +++ b/stdlib/source/test/lux/data/binary.lux @@ -40,7 +40,7 @@ [byte random.nat] (exec (try.assumed (/.write/8 idx byte output)) (recur (inc idx)))) - (\ random.monad wrap output))))) + (\ random.monad in output))))) (def: (throws? exception try) (All [e a] (-> (Exception e) (Try a) Bit)) @@ -64,8 +64,8 @@ [pre (read 0 binary) _ (write 0 value binary) post (read 0 binary)] - (wrap (and (n.= 0 pre) - (n.= capped_value post))))) + (in (and (n.= 0 pre) + (n.= capped_value post))))) (throws? /.index_out_of_bounds (read 1 binary)) (throws? /.index_out_of_bounds (write 1 value binary))))) @@ -158,6 +158,6 @@ copy (/.copy 1 0 sample 0 (/.create 2)) copy/0 (/.read/8 0 copy) copy/1 (/.read/8 1 copy)] - (wrap (and (n.= sample/0 copy/0) - (n.= 0 copy/1))))))) + (in (and (n.= sample/0 copy/0) + (n.= 0 copy/1))))))) ))))) diff --git a/stdlib/source/test/lux/data/collection/bits.lux b/stdlib/source/test/lux/data/collection/bits.lux index 3e8b89d2a..402f52379 100644 --- a/stdlib/source/test/lux/data/collection/bits.lux +++ b/stdlib/source/test/lux/data/collection/bits.lux @@ -24,10 +24,10 @@ (do {! random.monad} [size (\ ! map (n.% 1,000) random.nat)] (case size - 0 (wrap /.empty) + 0 (in /.empty) _ (do {! random.monad} [idx (|> random.nat (\ ! map (n.% size)))] - (wrap (/.set idx /.empty)))))) + (in (/.set idx /.empty)))))) (def: #export test Test @@ -63,8 +63,8 @@ (and (n.= 0 (/.capacity /.empty)) (|> /.empty (/.set idx) /.capacity (n.- idx) - (predicate.unite (n.>= 0) - (n.< /.chunk_size))) + (predicate.or (n.>= 0) + (n.< /.chunk_size))) (let [grown (/.flip idx /.empty)] (and (n.> 0 (/.capacity grown)) (is? /.empty (/.flip idx grown)))))) diff --git a/stdlib/source/test/lux/data/collection/dictionary/ordered.lux b/stdlib/source/test/lux/data/collection/dictionary/ordered.lux index 19c6bfde6..0b98204a9 100644 --- a/stdlib/source/test/lux/data/collection/dictionary/ordered.lux +++ b/stdlib/source/test/lux/data/collection/dictionary/ordered.lux @@ -27,7 +27,7 @@ (-> (Order k) (Random k) (Random v) Nat (Random (/.Dictionary k v)))) (case size 0 - (random\wrap (/.new order)) + (random\in (/.new order)) _ (do random.monad @@ -35,7 +35,7 @@ key (random.only (|>> (/.key? partial) not) gen_key) value gen_value] - (wrap (/.put key value partial))))) + (in (/.put key value partial))))) (def: #export test Test diff --git a/stdlib/source/test/lux/data/collection/dictionary/plist.lux b/stdlib/source/test/lux/data/collection/dictionary/plist.lux index f7450e3d1..7916da3eb 100644 --- a/stdlib/source/test/lux/data/collection/dictionary/plist.lux +++ b/stdlib/source/test/lux/data/collection/dictionary/plist.lux @@ -26,7 +26,7 @@ (do random.monad [keys (random.set text.hash size gen_key) values (random.list size gen_value)] - (wrap (list.zipped/2 (set.to_list keys) values)))) + (in (list.zipped/2 (set.to_list keys) values)))) (def: #export test Test diff --git a/stdlib/source/test/lux/data/collection/list.lux b/stdlib/source/test/lux/data/collection/list.lux index f3175fbb5..207ba73d9 100644 --- a/stdlib/source/test/lux/data/collection/list.lux +++ b/stdlib/source/test/lux/data/collection/list.lux @@ -57,13 +57,13 @@ (_.for [/.monoid] ($monoid.spec (/.equivalence n.equivalence) /.monoid ..random)) (_.for [/.fold] - ($fold.spec /\wrap /.equivalence /.fold)) + ($fold.spec /\in /.equivalence /.fold)) (_.for [/.functor] - ($functor.spec /\wrap /.equivalence /.functor)) + ($functor.spec /\in /.equivalence /.functor)) (_.for [/.apply] - ($apply.spec /\wrap /.equivalence /.apply)) + ($apply.spec /\in /.equivalence /.apply)) (_.for [/.monad] - ($monad.spec /\wrap /.equivalence /.monad)) + ($monad.spec /\in /.equivalence /.monad)) (do {! random.monad} [parameter random.nat @@ -73,9 +73,9 @@ expected (n.+ parameter subject)] (_.cover [/.with /.lift] (|> (io.run (do (/.with io.monad) - [a (lift (io\wrap parameter)) - b (wrap subject)] - (wrap (n.+ a b)))) + [a (lift (io\in parameter)) + b (in subject)] + (in (n.+ a b)))) (case> (^ (list actual)) (n.= expected actual) diff --git a/stdlib/source/test/lux/data/collection/queue/priority.lux b/stdlib/source/test/lux/data/collection/queue/priority.lux index a43b0e278..06238c4c8 100644 --- a/stdlib/source/test/lux/data/collection/queue/priority.lux +++ b/stdlib/source/test/lux/data/collection/queue/priority.lux @@ -21,7 +21,7 @@ (monad.fold ! (function (_ head tail) (do ! [priority random.nat] - (wrap (/.push priority head tail)))) + (in (/.push priority head tail)))) /.empty inputs))) diff --git a/stdlib/source/test/lux/data/collection/row.lux b/stdlib/source/test/lux/data/collection/row.lux index fdd2c6276..407fcde8e 100644 --- a/stdlib/source/test/lux/data/collection/row.lux +++ b/stdlib/source/test/lux/data/collection/row.lux @@ -36,13 +36,13 @@ (_.for [/.monoid] ($monoid.spec (/.equivalence n.equivalence) /.monoid (random.row size random.nat))) (_.for [/.fold] - ($fold.spec /\wrap /.equivalence /.fold)) + ($fold.spec /\in /.equivalence /.fold)) (_.for [/.functor] - ($functor.spec /\wrap /.equivalence /.functor)) + ($functor.spec /\in /.equivalence /.functor)) (_.for [/.apply] - ($apply.spec /\wrap /.equivalence /.apply)) + ($apply.spec /\in /.equivalence /.apply)) (_.for [/.monad] - ($monad.spec /\wrap /.equivalence /.monad)) + ($monad.spec /\in /.equivalence /.monad)) ))) (def: whole @@ -103,14 +103,14 @@ (do try.monad [sample (/.put good_index non_member sample) actual (/.nth good_index sample)] - (wrap (is? non_member actual))))) + (in (is? non_member actual))))) (_.cover [/.update] (<| (try.default false) (do try.monad [sample (/.put good_index non_member sample) sample (/.update good_index inc sample) actual (/.nth good_index sample)] - (wrap (n.= (inc non_member) actual))))) + (in (n.= (inc non_member) actual))))) (_.cover [/.within_bounds?] (and (/.within_bounds? sample good_index) (not (/.within_bounds? sample bad_index)))) diff --git a/stdlib/source/test/lux/data/collection/set/multi.lux b/stdlib/source/test/lux/data/collection/set/multi.lux index 05752d6fa..197f35e93 100644 --- a/stdlib/source/test/lux/data/collection/set/multi.lux +++ b/stdlib/source/test/lux/data/collection/set/multi.lux @@ -30,11 +30,11 @@ (do {! random.monad} [elements (random.set hash size element) element_counts (random.list size ..count)] - (wrap (list\fold (function (_ [count element] set) - (/.add count element set)) - (/.new hash) - (list.zipped/2 element_counts - (set.to_list elements)))))) + (in (list\fold (function (_ [count element] set) + (/.add count element set)) + (/.new hash) + (list.zipped/2 element_counts + (set.to_list elements)))))) (def: signature Test diff --git a/stdlib/source/test/lux/data/collection/set/ordered.lux b/stdlib/source/test/lux/data/collection/set/ordered.lux index 260ab946f..0614a1938 100644 --- a/stdlib/source/test/lux/data/collection/set/ordered.lux +++ b/stdlib/source/test/lux/data/collection/set/ordered.lux @@ -27,14 +27,14 @@ (All [a] (-> Nat (Order a) (Random a) (Random (Set a)))) (case size 0 - (random\wrap (/.new &order)) + (random\in (/.new &order)) _ (do random.monad [partial (random (dec size) &order gen_value) value (random.only (|>> (/.member? partial) not) gen_value)] - (wrap (/.add value partial))))) + (in (/.add value partial))))) (def: #export test Test diff --git a/stdlib/source/test/lux/data/collection/tree.lux b/stdlib/source/test/lux/data/collection/tree.lux index a610fdef5..a263b2451 100644 --- a/stdlib/source/test/lux/data/collection/tree.lux +++ b/stdlib/source/test/lux/data/collection/tree.lux @@ -25,11 +25,11 @@ [value gen_value num_children (\ ! map (n.% 2) random.nat) children (random.list num_children (tree gen_value))] - (wrap [(|> children - (list\map product.left) - (list\fold n.+ 1)) - {#/.value value - #/.children (list\map product.right children)}]))) + (in [(|> children + (list\map product.left) + (list\fold n.+ 1)) + {#/.value value + #/.children (list\map product.right children)}]))) (def: #export test Test diff --git a/stdlib/source/test/lux/data/collection/tree/zipper.lux b/stdlib/source/test/lux/data/collection/tree/zipper.lux index 6487e5685..35b55f4bf 100644 --- a/stdlib/source/test/lux/data/collection/tree/zipper.lux +++ b/stdlib/source/test/lux/data/collection/tree/zipper.lux @@ -36,7 +36,7 @@ /.zip (do> maybe.monad [/.down] - [/.value (n.= expected) wrap]) + [/.value (n.= expected) in]) (maybe.default false))) (_.cover [/.up] (|> (tree.branch expected (list (tree.leaf dummy))) @@ -44,7 +44,7 @@ (do> maybe.monad [/.down] [/.up] - [/.value (n.= expected) wrap]) + [/.value (n.= expected) in]) (maybe.default false))) (_.cover [/.right] (|> (tree.branch dummy (list (tree.leaf dummy) (tree.leaf expected))) @@ -52,7 +52,7 @@ (do> maybe.monad [/.down] [/.right] - [/.value (n.= expected) wrap]) + [/.value (n.= expected) in]) (maybe.default false))) (_.cover [/.rightmost] (|> (tree.branch dummy @@ -64,7 +64,7 @@ (do> maybe.monad [/.down] [/.rightmost] - [/.value (n.= expected) wrap]) + [/.value (n.= expected) in]) (maybe.default false))) (_.cover [/.left] (|> (tree.branch dummy (list (tree.leaf expected) (tree.leaf dummy))) @@ -73,7 +73,7 @@ [/.down] [/.right] [/.left] - [/.value (n.= expected) wrap]) + [/.value (n.= expected) in]) (maybe.default false))) (_.cover [/.leftmost] (|> (tree.branch dummy @@ -86,7 +86,7 @@ [/.down] [/.rightmost] [/.leftmost] - [/.value (n.= expected) wrap]) + [/.value (n.= expected) in]) (maybe.default false))) (_.cover [/.next] (and (|> (tree.branch dummy @@ -95,7 +95,7 @@ /.zip (do> maybe.monad [/.next] - [/.value (n.= expected) wrap]) + [/.value (n.= expected) in]) (maybe.default false)) (|> (tree.branch dummy (list (tree.leaf dummy) @@ -104,7 +104,7 @@ (do> maybe.monad [/.next] [/.next] - [/.value (n.= expected) wrap]) + [/.value (n.= expected) in]) (maybe.default false)))) (_.cover [/.end] (|> (tree.branch dummy @@ -115,7 +115,7 @@ /.zip (do> maybe.monad [/.end] - [/.value (n.= expected) wrap]) + [/.value (n.= expected) in]) (maybe.default false))) (_.cover [/.start] (|> (tree.branch expected @@ -127,7 +127,7 @@ (do> maybe.monad [/.end] [/.start] - [/.value (n.= expected) wrap]) + [/.value (n.= expected) in]) (maybe.default false))) (_.cover [/.previous] (and (|> (tree.branch expected @@ -137,7 +137,7 @@ (do> maybe.monad [/.next] [/.previous] - [/.value (n.= expected) wrap]) + [/.value (n.= expected) in]) (maybe.default false)) (|> (tree.branch dummy (list (tree.leaf expected) @@ -147,7 +147,7 @@ [/.next] [/.next] [/.previous] - [/.value (n.= expected) wrap]) + [/.value (n.= expected) in]) (maybe.default false)))) ))) @@ -207,13 +207,13 @@ (|> cursor (do> maybe.monad [/.down] - [/.value (n.= expected) wrap]) + [/.value (n.= expected) in]) (maybe.default false)) (|> cursor (do> maybe.monad [/.down] [/.down] - [/.value (n.= dummy) wrap]) + [/.value (n.= dummy) in]) (maybe.default false))))) (_.cover [/.adopt] (let [cursor (|> (tree.branch dummy (list (tree.leaf dummy))) @@ -223,13 +223,13 @@ (|> cursor (do> maybe.monad [/.down] - [/.value (n.= expected) wrap]) + [/.value (n.= expected) in]) (maybe.default false)) (|> cursor (do> maybe.monad [/.down] [/.right] - [/.value (n.= dummy) wrap]) + [/.value (n.= dummy) in]) (maybe.default false))))) (_.cover [/.insert_left] (|> (tree.branch dummy (list (tree.leaf dummy))) @@ -238,7 +238,7 @@ [/.down] [(/.insert_left expected)] [/.left] - [/.value (n.= expected) wrap]) + [/.value (n.= expected) in]) (maybe.default false))) (_.cover [/.insert_right] (|> (tree.branch dummy (list (tree.leaf dummy))) @@ -247,7 +247,7 @@ [/.down] [(/.insert_right expected)] [/.right] - [/.value (n.= expected) wrap]) + [/.value (n.= expected) in]) (maybe.default false))) (_.cover [/.remove] (|> (tree.branch dummy (list (tree.leaf dummy))) @@ -256,6 +256,6 @@ [/.down] [(/.insert_left expected)] [/.remove] - [/.value (n.= expected) wrap]) + [/.value (n.= expected) in]) (maybe.default false))) )))) diff --git a/stdlib/source/test/lux/data/format/json.lux b/stdlib/source/test/lux/data/format/json.lux index 22dce27f1..e9acae043 100644 --- a/stdlib/source/test/lux/data/format/json.lux +++ b/stdlib/source/test/lux/data/format/json.lux @@ -38,7 +38,7 @@ (do {! random.monad} [size (\ ! map (n.% 2) random.nat)] ($_ random.or - (\ ! wrap []) + (\ ! in []) random.bit random.safe_frac (random.unicode size) @@ -49,17 +49,17 @@ (syntax: (boolean) (do meta.monad [value meta.count] - (wrap (list (code.bit (n.even? value)))))) + (in (list (code.bit (n.even? value)))))) (syntax: (number) (do meta.monad [value meta.count] - (wrap (list (code.frac (n.frac value)))))) + (in (list (code.frac (n.frac value)))))) (syntax: (string) (do meta.monad [value (macro.gensym "string")] - (wrap (list (code.text (%.code value)))))) + (in (list (code.text (%.code value)))))) (def: #export test Test @@ -132,8 +132,8 @@ (#try.Failure error) true)]] - (wrap (and can_find_known_key! - cannot_find_unknown_key!)))))) + (in (and can_find_known_key! + cannot_find_unknown_key!)))))) (~~ (template [<type> <get> <tag> <random> <equivalence>] [(do random.monad [key (random.ascii/alpha 1) @@ -189,11 +189,11 @@ value4 (/.get <key4> object) value5 (/.get <key5> object) value6 (/.get <key6> value5)] - (wrap (and (\= #/.Null value0) - (\= (#/.Boolean <boolean>) value1) - (\= (#/.Number <number>) value2) - (\= (#/.String <string>) value3) - (\= (#/.Array <array_row>) value4) - (\= (#/.Number <number>) value6)))))) + (in (and (\= #/.Null value0) + (\= (#/.Boolean <boolean>) value1) + (\= (#/.Number <number>) value2) + (\= (#/.String <string>) value3) + (\= (#/.Array <array_row>) value4) + (\= (#/.Number <number>) value6)))))) ))) )))) diff --git a/stdlib/source/test/lux/data/format/tar.lux b/stdlib/source/test/lux/data/format/tar.lux index fedcdd251..8dfe9635d 100644 --- a/stdlib/source/test/lux/data/format/tar.lux +++ b/stdlib/source/test/lux/data/format/tar.lux @@ -174,13 +174,13 @@ tar (|> (row.row (<tag> expected_path)) (format.run /.writer) (<b>.run /.parser))] - (wrap (case (row.to_list tar) - (^ (list (<tag> actual_path))) - (text\= (/.from_path expected_path) - (/.from_path actual_path)) + (in (case (row.to_list tar) + (^ (list (<tag> actual_path))) + (text\= (/.from_path expected_path) + (/.from_path actual_path)) - _ - false))) + _ + false))) (try.default false)))] [/.Symbolic_Link #/.Symbolic_Link] @@ -203,19 +203,19 @@ expected_content])) (format.run /.writer) (<b>.run /.parser))] - (wrap (case (row.to_list tar) - (^ (list (<tag> [actual_path actual_moment actual_mode actual_ownership actual_content]))) - (let [seconds (: (-> Instant Int) - (|>> instant.relative (duration.query duration.second)))] - (and (text\= (/.from_path expected_path) - (/.from_path actual_path)) - (i.= (seconds expected_moment) - (seconds actual_moment)) - (binary\= (/.data expected_content) - (/.data actual_content)))) - - _ - false))) + (in (case (row.to_list tar) + (^ (list (<tag> [actual_path actual_moment actual_mode actual_ownership actual_content]))) + (let [seconds (: (-> Instant Int) + (|>> instant.relative (duration.query duration.second)))] + (and (text\= (/.from_path expected_path) + (/.from_path actual_path)) + (i.= (seconds expected_moment) + (seconds actual_moment)) + (binary\= (/.data expected_content) + (/.data actual_content)))) + + _ + false))) (try.default false)))] [/.Normal #/.Normal] @@ -226,18 +226,18 @@ (Random /.Mode) (do {! random.monad} [] - (random.either (random.either (random.either (wrap /.execute_by_other) - (wrap /.write_by_other)) - (random.either (wrap /.read_by_other) - (wrap /.execute_by_group))) - (random.either (random.either (random.either (wrap /.write_by_group) - (wrap /.read_by_group)) - (random.either (wrap /.execute_by_owner) - (wrap /.write_by_owner))) - (random.either (random.either (wrap /.read_by_owner) - (wrap /.save_text)) - (random.either (wrap /.set_group_id_on_execution) - (wrap /.set_user_id_on_execution))))))) + (random.either (random.either (random.either (in /.execute_by_other) + (in /.write_by_other)) + (random.either (in /.read_by_other) + (in /.execute_by_group))) + (random.either (random.either (random.either (in /.write_by_group) + (in /.read_by_group)) + (random.either (in /.execute_by_owner) + (in /.write_by_owner))) + (random.either (random.either (in /.read_by_owner) + (in /.save_text)) + (random.either (in /.set_group_id_on_execution) + (in /.set_user_id_on_execution))))))) (def: mode Test @@ -261,13 +261,13 @@ content])) (format.run /.writer) (<b>.run /.parser))] - (wrap (case (row.to_list tar) - (^ (list (#/.Normal [_ _ actual_mode _ _]))) - (n.= (/.mode expected_mode) - (/.mode actual_mode)) + (in (case (row.to_list tar) + (^ (list (#/.Normal [_ _ actual_mode _ _]))) + (n.= (/.mode expected_mode) + (/.mode actual_mode)) - _ - false))) + _ + false))) (try.default false))) (~~ (template [<expected_mode>] [(_.cover [<expected_mode>] @@ -284,13 +284,13 @@ content])) (format.run /.writer) (<b>.run /.parser))] - (wrap (case (row.to_list tar) - (^ (list (#/.Normal [_ _ actual_mode _ _]))) - (n.= (/.mode <expected_mode>) - (/.mode actual_mode)) + (in (case (row.to_list tar) + (^ (list (#/.Normal [_ _ actual_mode _ _]))) + (n.= (/.mode <expected_mode>) + (/.mode actual_mode)) - _ - false))) + _ + false))) (try.default false)))] [/.none] @@ -351,15 +351,15 @@ content])) (format.run /.writer) (<b>.run /.parser))] - (wrap (case (row.to_list tar) - (^ (list (#/.Normal [_ _ _ actual_ownership _]))) - (and (text\= (/.from_name expected) - (/.from_name (get@ [#/.user #/.name] actual_ownership))) - (text\= (/.from_name /.anonymous) - (/.from_name (get@ [#/.group #/.name] actual_ownership)))) - - _ - false))) + (in (case (row.to_list tar) + (^ (list (#/.Normal [_ _ _ actual_ownership _]))) + (and (text\= (/.from_name expected) + (/.from_name (get@ [#/.user #/.name] actual_ownership))) + (text\= (/.from_name /.anonymous) + (/.from_name (get@ [#/.group #/.name] actual_ownership)))) + + _ + false))) (try.default false))) (_.cover [/.anonymous /.no_id] (|> (do try.monad @@ -375,19 +375,19 @@ content])) (format.run /.writer) (<b>.run /.parser))] - (wrap (case (row.to_list tar) - (^ (list (#/.Normal [_ _ _ actual_ownership _]))) - (and (text\= (/.from_name /.anonymous) - (/.from_name (get@ [#/.user #/.name] actual_ownership))) - (n.= (/.from_small /.no_id) - (/.from_small (get@ [#/.user #/.id] actual_ownership))) - (text\= (/.from_name /.anonymous) - (/.from_name (get@ [#/.group #/.name] actual_ownership))) - (n.= (/.from_small /.no_id) - (/.from_small (get@ [#/.group #/.id] actual_ownership)))) - - _ - false))) + (in (case (row.to_list tar) + (^ (list (#/.Normal [_ _ _ actual_ownership _]))) + (and (text\= (/.from_name /.anonymous) + (/.from_name (get@ [#/.user #/.name] actual_ownership))) + (n.= (/.from_small /.no_id) + (/.from_small (get@ [#/.user #/.id] actual_ownership))) + (text\= (/.from_name /.anonymous) + (/.from_name (get@ [#/.group #/.name] actual_ownership))) + (n.= (/.from_small /.no_id) + (/.from_small (get@ [#/.group #/.id] actual_ownership)))) + + _ + false))) (try.default false))) )))) @@ -396,7 +396,7 @@ (<| (_.covering /._) (_.for [/.Tar]) (do random.monad - [_ (wrap [])] + [_ (in [])] ($_ _.and (_.cover [/.writer /.parser] (|> row.empty diff --git a/stdlib/source/test/lux/data/format/xml.lux b/stdlib/source/test/lux/data/format/xml.lux index 7c9267b16..e73e4960a 100644 --- a/stdlib/source/test/lux/data/format/xml.lux +++ b/stdlib/source/test/lux/data/format/xml.lux @@ -37,7 +37,7 @@ (Random Nat) (do {! random.monad} [idx (|> random.nat (\ ! map (n.% (text.size char_range))))] - (wrap (maybe.assume (text.nth idx char_range))))) + (in (maybe.assume (text.nth idx char_range))))) (def: (size bottom top) (-> Nat Nat (Random Nat)) diff --git a/stdlib/source/test/lux/data/maybe.lux b/stdlib/source/test/lux/data/maybe.lux index 899541f37..c2baca4fa 100644 --- a/stdlib/source/test/lux/data/maybe.lux +++ b/stdlib/source/test/lux/data/maybe.lux @@ -39,11 +39,11 @@ (_.for [/.monoid] ($monoid.spec (/.equivalence n.equivalence) /.monoid (random.maybe random.nat))) (_.for [/.functor] - ($functor.spec /\wrap /.equivalence /.functor)) + ($functor.spec /\in /.equivalence /.functor)) (_.for [/.apply] - ($apply.spec /\wrap /.equivalence /.apply)) + ($apply.spec /\in /.equivalence /.apply)) (_.for [/.monad] - ($monad.spec /\wrap /.equivalence /.monad)) + ($monad.spec /\in /.equivalence /.monad)) (do random.monad [left random.nat @@ -52,9 +52,9 @@ (let [lift (/.lift io.monad)] (_.cover [/.with /.lift] (|> (io.run (do (/.with io.monad) - [a (lift (io\wrap left)) - b (wrap right)] - (wrap (n.+ a b)))) + [a (lift (io\in left)) + b (in right)] + (in (n.+ a b)))) (case> (#.Some actual) (n.= expected actual) diff --git a/stdlib/source/test/lux/data/text/encoding.lux b/stdlib/source/test/lux/data/text/encoding.lux index 3b7f83b72..11a68ea33 100644 --- a/stdlib/source/test/lux/data/text/encoding.lux +++ b/stdlib/source/test/lux/data/text/encoding.lux @@ -215,7 +215,7 @@ (let [options (list.size ..all_encodings)] (do {! random.monad} [choice (\ ! map (n.% options) random.nat)] - (wrap (maybe.assume (list.nth choice ..all_encodings)))))) + (in (maybe.assume (list.nth choice ..all_encodings)))))) (def: #export test Test diff --git a/stdlib/source/test/lux/data/text/escape.lux b/stdlib/source/test/lux/data/text/escape.lux index 203cf9b81..73f9455d7 100644 --- a/stdlib/source/test/lux/data/text/escape.lux +++ b/stdlib/source/test/lux/data/text/escape.lux @@ -74,10 +74,10 @@ [seed meta.count #let [[_ expected] (random.run (random.pcg32 [seed seed]) (random.ascii 10))]] - (wrap (list (code.text expected))))) + (in (list (code.text expected))))) (syntax: (static_escape {un_escaped <code>.text}) - (wrap (list (code.text (/.escape un_escaped))))) + (in (list (code.text (/.escape un_escaped))))) (def: #export test Test diff --git a/stdlib/source/test/lux/data/text/format.lux b/stdlib/source/test/lux/data/text/format.lux index d339e0717..e8cdb1e67 100644 --- a/stdlib/source/test/lux/data/text/format.lux +++ b/stdlib/source/test/lux/data/text/format.lux @@ -62,11 +62,11 @@ (Random (Ex [a] [(/.Format a) (Random a)])) ($_ random.either - (random\wrap [/.bit random.bit]) - (random\wrap [/.nat random.nat]) - (random\wrap [/.int random.int]) - (random\wrap [/.rev random.rev]) - (random\wrap [/.frac random.frac]) + (random\in [/.bit random.bit]) + (random\in [/.nat random.nat]) + (random\in [/.int random.int]) + (random\in [/.rev random.rev]) + (random\in [/.frac random.frac]) )) (def: codec diff --git a/stdlib/source/test/lux/data/text/regex.lux b/stdlib/source/test/lux/data/text/regex.lux index 50498f396..52053f108 100644 --- a/stdlib/source/test/lux/data/text/regex.lux +++ b/stdlib/source/test/lux/data/text/regex.lux @@ -53,13 +53,13 @@ (syntax: (should_check pattern regex input) (macro.with_gensyms [g!message g!_] - (wrap (list (` (|> (~ input) - (<text>.run (~ regex)) - (case> (^ (#try.Success (~ pattern))) - true + (in (list (` (|> (~ input) + (<text>.run (~ regex)) + (case> (^ (#try.Success (~ pattern))) + true - (~ g!_) - false))))))) + (~ g!_) + false))))))) (def: basics Test diff --git a/stdlib/source/test/lux/data/text/unicode/block.lux b/stdlib/source/test/lux/data/text/unicode/block.lux index b895df0de..d08f41fa8 100644 --- a/stdlib/source/test/lux/data/text/unicode/block.lux +++ b/stdlib/source/test/lux/data/text/unicode/block.lux @@ -27,7 +27,7 @@ (do random.monad [start random.nat end random.nat] - (wrap (/.block start end)))) + (in (/.block start end)))) (with_expansions [<blocks> (as_is [blocks/0 [/.basic_latin diff --git a/stdlib/source/test/lux/data/text/unicode/set.lux b/stdlib/source/test/lux/data/text/unicode/set.lux index e70816efe..054c6c6f7 100644 --- a/stdlib/source/test/lux/data/text/unicode/set.lux +++ b/stdlib/source/test/lux/data/text/unicode/set.lux @@ -28,7 +28,7 @@ (do {! random.monad} [left //block.random right //block.random] - (wrap (/.set [left (list right)])))) + (in (/.set [left (list right)])))) (def: #export test Test diff --git a/stdlib/source/test/lux/debug.lux b/stdlib/source/test/lux/debug.lux index c55928c15..638afd90f 100644 --- a/stdlib/source/test/lux/debug.lux +++ b/stdlib/source/test/lux/debug.lux @@ -55,18 +55,18 @@ sample_text (random.ascii/upper 10) sample_nat random.nat sample_rev random.rev] - (wrap (`` (and (~~ (template [<type> <format> <sample>] - [(|> (/.representation <type> <sample>) - (try\map (text\= (<format> <sample>))) - (try.default false))] + (in (`` (and (~~ (template [<type> <format> <sample>] + [(|> (/.representation <type> <sample>) + (try\map (text\= (<format> <sample>))) + (try.default false))] - [Bit %.bit sample_bit] - [Nat %.nat sample_nat] - [Int %.int sample_int] - [Rev %.rev sample_rev] - [Frac %.frac sample_frac] - [Text %.text sample_text])) - ))))) + [Bit %.bit sample_bit] + [Nat %.nat sample_nat] + [Int %.int sample_int] + [Rev %.rev sample_rev] + [Frac %.frac sample_frac] + [Text %.text sample_text])) + ))))) (def: can_represent_structure_types (Random Bit) @@ -74,32 +74,32 @@ [sample_bit random.bit sample_int random.int sample_frac random.frac] - (wrap (`` (and (case (/.representation (type [Bit Int Frac]) - [sample_bit sample_int sample_frac]) - (#try.Success actual) - (text\= (format "[" (%.bit sample_bit) - " " (%.int sample_int) - " " (%.frac sample_frac) - "]") - actual) + (in (`` (and (case (/.representation (type [Bit Int Frac]) + [sample_bit sample_int sample_frac]) + (#try.Success actual) + (text\= (format "[" (%.bit sample_bit) + " " (%.int sample_int) + " " (%.frac sample_frac) + "]") + actual) - (#try.Failure error) - false) - ## TODO: Uncomment after switching from the old (tag+last?) to the new (lefts+right?) representation for variants - ## (~~ (template [<lefts> <right?> <value> <format>] - ## [(|> (/.representation (type (| Bit Int Frac)) - ## (: (| Bit Int Frac) - ## (<lefts> <right?> <value>))) - ## (try\map (text\= (format "(" (%.nat <lefts>) - ## " " (%.bit <right?>) - ## " " (<format> <value>) ")"))) - ## (try.default false))] + (#try.Failure error) + false) + ## TODO: Uncomment after switching from the old (tag+last?) to the new (lefts+right?) representation for variants + ## (~~ (template [<lefts> <right?> <value> <format>] + ## [(|> (/.representation (type (| Bit Int Frac)) + ## (: (| Bit Int Frac) + ## (<lefts> <right?> <value>))) + ## (try\map (text\= (format "(" (%.nat <lefts>) + ## " " (%.bit <right?>) + ## " " (<format> <value>) ")"))) + ## (try.default false))] - ## [0 #0 sample_bit %.bit] - ## [1 #0 sample_int %.int] - ## [1 #1 sample_frac %.frac] - ## )) - ))))) + ## [0 #0 sample_bit %.bit] + ## [1 #0 sample_int %.int] + ## [1 #1 sample_frac %.frac] + ## )) + ))))) (def: can_represent_complex_types (Random Bit) @@ -111,19 +111,19 @@ sample_code $//code.random sample_xml $//xml.random sample_json $//json.random] - (wrap (`` (and (~~ (template [<type> <format> <sample>] - [(|> (/.representation <type> <sample>) - (try\map (text\= (<format> <sample>))) - (try.default false))] + (in (`` (and (~~ (template [<type> <format> <sample>] + [(|> (/.representation <type> <sample>) + (try\map (text\= (<format> <sample>))) + (try.default false))] - [Ratio %.ratio sample_ratio] - [Name %.name sample_name] - [Location %.location sample_location] - [Code %.code sample_code] - [Type %.type sample_type] - [XML %.xml sample_xml] - [JSON %.json sample_json])) - ))))) + [Ratio %.ratio sample_ratio] + [Name %.name sample_name] + [Location %.location sample_location] + [Code %.code sample_code] + [Type %.type sample_type] + [XML %.xml sample_xml] + [JSON %.json sample_json])) + ))))) (def: can_represent_time_types (Random Bit) @@ -134,18 +134,18 @@ sample_month random.month sample_time random.time sample_day random.day] - (wrap (`` (and (~~ (template [<type> <format> <sample>] - [(|> (/.representation <type> <sample>) - (try\map (text\= (<format> <sample>))) - (try.default false))] + (in (`` (and (~~ (template [<type> <format> <sample>] + [(|> (/.representation <type> <sample>) + (try\map (text\= (<format> <sample>))) + (try.default false))] - [Instant %.instant sample_instant] - [Duration %.duration sample_duration] - [Date %.date sample_date] - [Month %.month sample_month] - [Time %.time sample_time] - [Day %.day sample_day])) - ))))) + [Instant %.instant sample_instant] + [Duration %.duration sample_duration] + [Date %.date sample_date] + [Month %.month sample_month] + [Time %.time sample_time] + [Day %.day sample_day])) + ))))) (def: representation Test diff --git a/stdlib/source/test/lux/extension.lux b/stdlib/source/test/lux/extension.lux index 39597a8a3..bab7b9007 100644 --- a/stdlib/source/test/lux/extension.lux +++ b/stdlib/source/test/lux/extension.lux @@ -89,13 +89,13 @@ (phase archive pass_through))) (analysis: (..dummy_generation self phase archive) - (\ phase.monad wrap (#analysis.Extension self (list)))) + (\ phase.monad in (#analysis.Extension self (list)))) (synthesis: (..dummy_generation self phase archive) - (\ phase.monad wrap (#synthesis.Extension self (list)))) + (\ phase.monad in (#synthesis.Extension self (list)))) (generation: (..dummy_generation self phase archive) - (\ phase.monad wrap + (\ phase.monad in (for {@.jvm (row.row (#jvm.Constant (#jvm.LDC (#jvm.String self)))) @@ -110,7 +110,7 @@ (directive: (..my_directive self phase archive {parameters (<>.some <code>.any)}) (do phase.monad [#let [_ (debug.log! (format "Successfully installed directive " (%.text self) "!"))]] - (wrap directive.no_requirements))) + (in directive.no_requirements))) (`` ((~~ (static ..my_directive)))) )) diff --git a/stdlib/source/test/lux/locale.lux b/stdlib/source/test/lux/locale.lux index 3bb0be6ab..298b4cf7d 100644 --- a/stdlib/source/test/lux/locale.lux +++ b/stdlib/source/test/lux/locale.lux @@ -24,18 +24,18 @@ (def: random_language (Random Language) - (random.either (random\wrap language.afar) - (random\wrap language.zaza))) + (random.either (random\in language.afar) + (random\in language.zaza))) (def: random_territory (Random Territory) - (random.either (random\wrap territory.afghanistan) - (random\wrap territory.zimbabwe))) + (random.either (random\in territory.afghanistan) + (random\in territory.zimbabwe))) (def: random_encoding (Random Encoding) - (random.either (random\wrap encoding.ascii) - (random\wrap encoding.koi8_u))) + (random.either (random\in encoding.ascii) + (random\in encoding.koi8_u))) (def: random_locale (Random /.Locale) @@ -43,7 +43,7 @@ [language ..random_language territory ..random_territory encoding ..random_encoding] - (wrap (/.locale language (#.Some territory) (#.Some encoding))))) + (in (/.locale language (#.Some territory) (#.Some encoding))))) (def: #export test Test diff --git a/stdlib/source/test/lux/locale/language.lux b/stdlib/source/test/lux/locale/language.lux index df8f798c6..3bbae852f 100644 --- a/stdlib/source/test/lux/locale/language.lux +++ b/stdlib/source/test/lux/locale/language.lux @@ -282,7 +282,7 @@ (do {! random.monad} [choice (\ ! map (n.% (list.size options)) random.nat)] - (wrap (maybe.assume (list.nth choice options)))))) + (in (maybe.assume (list.nth choice options)))))) (def: #export test Test diff --git a/stdlib/source/test/lux/locale/territory.lux b/stdlib/source/test/lux/locale/territory.lux index 381c8f673..10619ea9f 100644 --- a/stdlib/source/test/lux/locale/territory.lux +++ b/stdlib/source/test/lux/locale/territory.lux @@ -208,7 +208,7 @@ (do {! random.monad} [choice (\ ! map (n.% (list.size options)) random.nat)] - (wrap (maybe.assume (list.nth choice options)))))) + (in (maybe.assume (list.nth choice options)))))) (def: #export test Test diff --git a/stdlib/source/test/lux/macro.lux b/stdlib/source/test/lux/macro.lux index 98d3ead2b..20db9b265 100644 --- a/stdlib/source/test/lux/macro.lux +++ b/stdlib/source/test/lux/macro.lux @@ -43,18 +43,18 @@ [(template.text [<definition>]) (#.Definition [true .Macro (' []) <definition>])])) (syntax: (pow/2 number) - (wrap (list (` (nat.* (~ number) (~ number)))))) + (in (list (` (nat.* (~ number) (~ number)))))) (syntax: (pow/4 number) - (wrap (list (` (..pow/2 (..pow/2 (~ number))))))) + (in (list (` (..pow/2 (..pow/2 (~ number))))))) (syntax: (repeat {times <code>.nat} token) - (wrap (list.repeat times token))) + (in (list.repeat times token))) (syntax: (fresh_identifier) (do meta.monad [g!fresh (/.gensym "fresh")] - (wrap (list g!fresh)))) + (in (list g!fresh)))) (def: random_lux (Random [Nat Text .Lux]) @@ -63,47 +63,47 @@ gensym_prefix (random.ascii/upper 1) #let [macro_module (name.module (name_of /._)) current_module (name.module (name_of .._))]] - (wrap [seed - gensym_prefix - {#.info {#.target "" - #.version "" - #.mode #.Build} - #.source [location.dummy 0 ""] - #.location location.dummy - #.current_module (#.Some current_module) - #.modules (list [macro_module - {#.module_hash 0 - #.module_aliases (list) - #.definitions (: (List [Text .Global]) - (list (!global /.log_expand_once!) - (!global /.log_expand!) - (!global /.log_expand_all!))) - #.imports (list) - #.tags (list) - #.types (list) - #.module_annotations #.None - #.module_state #.Active}] - [current_module - {#.module_hash 0 - #.module_aliases (list) - #.definitions (: (List [Text .Global]) - (list (!global ..pow/2) - (!global ..pow/4) - (!global ..repeat))) - #.imports (list) - #.tags (list) - #.types (list) - #.module_annotations #.None - #.module_state #.Active}]) - #.scopes (list) - #.type_context {#.ex_counter 0 - #.var_counter 0 - #.var_bindings (list)} - #.expected #.None - #.seed seed - #.scope_type_vars (list) - #.extensions [] - #.host []}]))) + (in [seed + gensym_prefix + {#.info {#.target "" + #.version "" + #.mode #.Build} + #.source [location.dummy 0 ""] + #.location location.dummy + #.current_module (#.Some current_module) + #.modules (list [macro_module + {#.module_hash 0 + #.module_aliases (list) + #.definitions (: (List [Text .Global]) + (list (!global /.log_expand_once!) + (!global /.log_expand!) + (!global /.log_expand_all!))) + #.imports (list) + #.tags (list) + #.types (list) + #.module_annotations #.None + #.module_state #.Active}] + [current_module + {#.module_hash 0 + #.module_aliases (list) + #.definitions (: (List [Text .Global]) + (list (!global ..pow/2) + (!global ..pow/4) + (!global ..repeat))) + #.imports (list) + #.tags (list) + #.types (list) + #.module_annotations #.None + #.module_state #.Active}]) + #.scopes (list) + #.type_context {#.ex_counter 0 + #.var_counter 0 + #.var_bindings (list)} + #.expected #.None + #.seed seed + #.scope_type_vars (list) + #.extensions [] + #.host []}]))) (def: expander Test @@ -171,7 +171,7 @@ (_.cover [/.with_gensyms] (with_expansions [<expected> (fresh_identifier)] (|> (/.with_gensyms [<expected>] - (\ meta.monad wrap <expected>)) + (\ meta.monad in <expected>)) (meta.run lux) (!expect (^multi (#try.Success [_ (#.Identifier ["" actual])]) (text.contains? (template.text [<expected>]) diff --git a/stdlib/source/test/lux/macro/code.lux b/stdlib/source/test/lux/macro/code.lux index 1a99aae83..5d5f9121a 100644 --- a/stdlib/source/test/lux/macro/code.lux +++ b/stdlib/source/test/lux/macro/code.lux @@ -87,10 +87,10 @@ (function (_ to_code) (do {! random.monad} [parts (..random_sequence replace_simulation)] - (wrap [(to_code (list\map product.left parts)) - (to_code (list\map product.right parts))]))))] + (in [(to_code (list\map product.left parts)) + (to_code (list\map product.right parts))]))))] ($_ random.either - (random\wrap [original substitute]) + (random\in [original substitute]) (do {! random.monad} [sample (random.only (|>> (\ /.equivalence = original) not) ($_ random.either @@ -102,15 +102,15 @@ (random\map /.text ..random_text) (random\map /.identifier ..random_name) (random\map /.tag ..random_name)))] - (wrap [sample sample])) + (in [sample sample])) (for_sequence /.form) (for_sequence /.tuple) (do {! random.monad} [parts (..random_sequence replace_simulation)] - (wrap [(/.record (let [parts' (list\map product.left parts)] - (list.zipped/2 parts' parts'))) - (/.record (let [parts' (list\map product.right parts)] - (list.zipped/2 parts' parts')))])) + (in [(/.record (let [parts' (list\map product.left parts)] + (list.zipped/2 parts' parts'))) + (/.record (let [parts' (list\map product.right parts)] + (list.zipped/2 parts' parts')))])) ))))) (def: for_format diff --git a/stdlib/source/test/lux/macro/local.lux b/stdlib/source/test/lux/macro/local.lux index 65e8e62f5..37b718a8e 100644 --- a/stdlib/source/test/lux/macro/local.lux +++ b/stdlib/source/test/lux/macro/local.lux @@ -56,13 +56,13 @@ (function (_ lux) (#try.Success [(update@ #.modules (plist.update module remove_macro!) lux) []]))) - (wrap []))] + (in []))] (let [pre_expansion (` (let [(~ g!output) (~ body)] (exec (~ pop!) (~ g!output))))] (if pre_remove (macro.expand_all pre_expansion) - (wrap (list pre_expansion))))))) + (in (list pre_expansion))))))) (def: #export test Test diff --git a/stdlib/source/test/lux/macro/syntax.lux b/stdlib/source/test/lux/macro/syntax.lux index 35d680974..49ba85da7 100644 --- a/stdlib/source/test/lux/macro/syntax.lux +++ b/stdlib/source/test/lux/macro/syntax.lux @@ -21,7 +21,7 @@ ["#/." variable]]]) (/.syntax: (+/3 a b c) - (wrap (list (` ($_ n.+ (~ a) (~ b) (~ c)))))) + (in (list (` ($_ n.+ (~ a) (~ b) (~ c)))))) (def: #export test Test diff --git a/stdlib/source/test/lux/math/logic/fuzzy.lux b/stdlib/source/test/lux/math/logic/fuzzy.lux index 9c7cca0ee..0beb03ada 100644 --- a/stdlib/source/test/lux/math/logic/fuzzy.lux +++ b/stdlib/source/test/lux/math/logic/fuzzy.lux @@ -314,8 +314,8 @@ #let [bottom (r.min threshold_0 threshold_1) top (r.max threshold_0 threshold_1)]] - (wrap [[bottom top] - (/.gradient bottom top)]))) + (in [[bottom top] + (/.gradient bottom top)]))) (def: threshold Test diff --git a/stdlib/source/test/lux/math/modular.lux b/stdlib/source/test/lux/math/modular.lux index 3f313bd12..e8865d207 100644 --- a/stdlib/source/test/lux/math/modular.lux +++ b/stdlib/source/test/lux/math/modular.lux @@ -42,8 +42,8 @@ [param\\% ($//.random +1,000,000) param (..random param\\%) - subject\\% (random.only (predicate.intersect (|>> //.divisor (i.> +2)) - (|>> (//.= param\\%) not)) + subject\\% (random.only (predicate.and (|>> //.divisor (i.> +2)) + (|>> (//.= param\\%) not)) ($//.random +1,000,000)) subject (..random subject\\%) another (..random subject\\%)] @@ -109,11 +109,11 @@ (do try.monad [copy\\% (//.modulus (//.divisor subject\\%)) adapt (/.adapter subject\\% copy\\%)] - (wrap (|> subject - /.value - (/.modular copy\\%) - adapt - (/.= subject)))))) + (in (|> subject + /.value + (/.modular copy\\%) + adapt + (/.= subject)))))) (_.cover [/.moduli_are_not_equal] (case (/.adapter subject\\% param\\%) (#try.Failure error) diff --git a/stdlib/source/test/lux/math/modulus.lux b/stdlib/source/test/lux/math/modulus.lux index 8679cdb70..16fcdba76 100644 --- a/stdlib/source/test/lux/math/modulus.lux +++ b/stdlib/source/test/lux/math/modulus.lux @@ -21,9 +21,9 @@ (syntax: (|divisor|) (do meta.monad [divisor meta.count] - (wrap (list (code.int (case divisor - 0 +1 - _ (.int divisor))))))) + (in (list (code.int (case divisor + 0 +1 + _ (.int divisor))))))) (def: #export (random range) (Ex [%] (-> Int (Random (/.Modulus %)))) diff --git a/stdlib/source/test/lux/math/number/complex.lux b/stdlib/source/test/lux/math/number/complex.lux index a1ebf331d..e5f43c47d 100644 --- a/stdlib/source/test/lux/math/number/complex.lux +++ b/stdlib/source/test/lux/math/number/complex.lux @@ -30,15 +30,15 @@ (do {! random.monad} [factor (|> random.nat (\ ! map (|>> (n.% 1000) (n.max 1)))) measure (|> random.safe_frac (random.only (f.> +0.0)))] - (wrap (f.* (|> factor .int int.frac) - measure)))) + (in (f.* (|> factor .int int.frac) + measure)))) (def: #export random (Random /.Complex) (do random.monad [real ..dimension imaginary ..dimension] - (wrap (/.complex real imaginary)))) + (in (/.complex real imaginary)))) (def: angle (Random /.Complex) diff --git a/stdlib/source/test/lux/math/number/ratio.lux b/stdlib/source/test/lux/math/number/ratio.lux index c78db2b86..b4c9799cc 100644 --- a/stdlib/source/test/lux/math/number/ratio.lux +++ b/stdlib/source/test/lux/math/number/ratio.lux @@ -31,7 +31,7 @@ [numerator ..part denominator (random.only (|>> (n.= 0) not) ..part)] - (wrap (/.ratio numerator denominator)))) + (in (/.ratio numerator denominator)))) (def: #export test Test diff --git a/stdlib/source/test/lux/meta.lux b/stdlib/source/test/lux/meta.lux index 4010b9ce1..43a7ec41a 100644 --- a/stdlib/source/test/lux/meta.lux +++ b/stdlib/source/test/lux/meta.lux @@ -68,12 +68,12 @@ #.host []}]] ($_ _.and (_.cover [/.run] - (|> (\ /.monad wrap expected) + (|> (\ /.monad in expected) (/.run expected_lux) (!expect (^multi (#try.Success actual) (n.= expected actual))))) (_.cover [/.run'] - (|> (\ /.monad wrap expected) + (|> (\ /.monad in expected) (/.run' expected_lux) (!expect (^multi (#try.Success [actual_lux actual]) (and (is? expected_lux actual_lux) @@ -131,7 +131,7 @@ (!expect (^multi (#try.Failure actual_error) (text\= expected_error actual_error)))))) (_.cover [/.either] - (and (|> (/.either (\ /.monad wrap expected) + (and (|> (/.either (\ /.monad in expected) (: (Meta Nat) (/.failure expected_error))) (/.run expected_lux) @@ -139,7 +139,7 @@ (n.= expected actual)))) (|> (/.either (: (Meta Nat) (/.failure expected_error)) - (\ /.monad wrap expected)) + (\ /.monad in expected)) (/.run expected_lux) (!expect (^multi (#try.Success actual) (n.= expected actual)))) @@ -151,8 +151,8 @@ (!expect (^multi (#try.Failure actual_error) (text\= (location.with location.dummy expected_error) actual_error)))) - (|> (/.either (\ /.monad wrap expected) - (\ /.monad wrap dummy)) + (|> (/.either (\ /.monad in expected) + (\ /.monad in dummy)) (/.run expected_lux) (!expect (^multi (#try.Success actual) (n.= expected actual)))) @@ -225,8 +225,8 @@ (/.run expected_lux) (!expect (^multi (#try.Success actual_module) (is? expected_module actual_module))))) - (_.cover [/.find_module] - (|> (/.find_module expected_current_module) + (_.cover [/.module] + (|> (/.module expected_current_module) (/.run expected_lux) (!expect (^multi (#try.Success actual_module) (is? expected_module actual_module))))) @@ -316,7 +316,7 @@ (|> (do /.monad [pre /.count post /.count] - (wrap [pre post])) + (in [pre post])) (/.run expected_lux) (!expect (^multi (#try.Success [actual_pre actual_post]) (and (n.= expected_seed actual_pre) @@ -348,8 +348,8 @@ expected_type (\ ! map (function (_ name) (#.Primitive name (list))) (random.ascii/upper 1)) - expected_value (random.either (wrap .def:) - (wrap .macro:)) + expected_value (random.either (in .def:) + (in .macro:)) #let [expected_lux (: (-> Bit (Maybe Type) [(List [Text .Global]) @@ -469,8 +469,8 @@ (#.Primitive name (list))) (random.ascii/upper 1)) #let [expected_annotations (' [])] - expected_value (random.either (wrap .def:) - (wrap .macro:)) + expected_value (random.either (in .def:) + (in .macro:)) #let [expected_lux (: (-> Bit (Maybe Type) [(List [Text .Global]) @@ -524,22 +524,22 @@ #.extensions [] #.host []}])))]] ($_ _.and - (_.cover [/.find_export] + (_.cover [/.export] (and (let [[current_globals macro_globals expected_lux] (expected_lux true (#.Some expected_type))] - (|> (/.find_export [expected_macro_module expected_short]) + (|> (/.export [expected_macro_module expected_short]) (/.run expected_lux) (!expect (#try.Success _)))) (let [[current_globals macro_globals expected_lux] (expected_lux false (#.Some expected_type))] - (|> (/.find_export [expected_macro_module expected_short]) + (|> (/.export [expected_macro_module expected_short]) (/.run expected_lux) (!expect (#try.Failure _)))))) - (_.cover [/.find_macro] + (_.cover [/.macro] (let [same_module! (let [[current_globals macro_globals expected_lux] (expected_lux true (#.Some .Macro))] - (|> (/.find_macro [expected_macro_module expected_short]) + (|> (/.macro [expected_macro_module expected_short]) (/.run expected_lux) (!expect (^multi (#try.Success (#.Some actual_value)) (is? expected_value actual_value))))) @@ -547,21 +547,21 @@ not_macro! (let [[current_globals macro_globals expected_lux] (expected_lux true (#.Some expected_type))] - (|> (/.find_macro [expected_macro_module expected_short]) + (|> (/.macro [expected_macro_module expected_short]) (/.run expected_lux) (!expect (#try.Success #.None)))) not_found! (let [[current_globals macro_globals expected_lux] (expected_lux true #.None)] - (|> (/.find_macro [expected_macro_module expected_short]) + (|> (/.macro [expected_macro_module expected_short]) (/.run expected_lux) (!expect (#try.Success #.None)))) aliasing! (let [[current_globals macro_globals expected_lux] (expected_lux true (#.Some .Macro))] - (|> (/.find_macro [expected_current_module expected_short]) + (|> (/.macro [expected_current_module expected_short]) (/.run expected_lux) (!expect (^multi (#try.Success (#.Some actual_value)) (is? expected_value actual_value)))))] @@ -580,12 +580,12 @@ (/.run expected_lux) (try\map (name\= [expected_macro_module expected_short])) (try.default false))))) - (_.cover [/.find_def] + (_.cover [/.definition] (let [[current_globals macro_globals expected_lux] (expected_lux expected_exported? (#.Some expected_type)) definition! - (|> (/.find_def [expected_macro_module expected_short]) + (|> (/.definition [expected_macro_module expected_short]) (/.run expected_lux) (!expect (^multi (#try.Success (#.Definition [actual_exported? actual_type actual_annotations actual_value])) (and (bit\= expected_exported? actual_exported?) @@ -594,42 +594,42 @@ (is? (:as Any expected_value) actual_value))))) alias! - (|> (/.find_def [expected_current_module expected_short]) + (|> (/.definition [expected_current_module expected_short]) (/.run expected_lux) (!expect (^multi (#try.Success (#.Alias [actual_module actual_short])) (and (is? expected_macro_module actual_module) (is? expected_short actual_short)))))] (and definition! alias!))) - (_.cover [/.find_def_type] + (_.cover [/.definition_type] (let [[current_globals macro_globals expected_lux] (expected_lux expected_exported? (#.Some expected_type)) definition! - (|> (/.find_def_type [expected_macro_module expected_short]) + (|> (/.definition_type [expected_macro_module expected_short]) (/.run expected_lux) (!expect (^multi (#try.Success actual_type) (is? expected_type actual_type)))) alias! - (|> (/.find_def_type [expected_current_module expected_short]) + (|> (/.definition_type [expected_current_module expected_short]) (/.run expected_lux) (!expect (^multi (#try.Success actual_type) (is? expected_type actual_type))))] (and definition! alias!))) - (_.cover [/.find_type_def] + (_.cover [/.type_definition] (let [[current_globals macro_globals expected_lux] (expected_lux expected_exported? (#.Some .Type)) definition! - (|> (/.find_type_def [expected_macro_module expected_short]) + (|> (/.type_definition [expected_macro_module expected_short]) (/.run expected_lux) (!expect (^multi (#try.Success actual_value) (is? (:as .Type expected_value) actual_value)))) alias! - (|> (/.find_type_def [expected_current_module expected_short]) + (|> (/.type_definition [expected_current_module expected_short]) (/.run expected_lux) (!expect (^multi (#try.Success actual_value) (is? (:as .Type expected_value) actual_value))))] @@ -827,45 +827,45 @@ (list [name_1 type_1] [name_2 type_2])))) (try.default false)))) - (_.cover [/.find_var_type] - (and (|> (/.find_var_type name_0) + (_.cover [/.var_type] + (and (|> (/.var_type name_0) (/.run expected_lux) (try\map (\ type.equivalence = type_0)) (try.default false)) - (|> (/.find_var_type name_1) + (|> (/.var_type name_1) (/.run expected_lux) (try\map (\ type.equivalence = type_1)) (try.default false)) - (|> (/.find_var_type name_2) + (|> (/.var_type name_2) (/.run expected_lux) (try\map (\ type.equivalence = type_2)) (try.default false)) - (|> (/.find_var_type name_3) + (|> (/.var_type name_3) (/.run expected_lux) (try\map (\ type.equivalence = type_3)) (try.default false)))) - (_.cover [/.find_type] - (and (|> (/.find_type ["" name_0]) + (_.cover [/.type] + (and (|> (/.type ["" name_0]) (/.run expected_lux) (try\map (\ type.equivalence = type_0)) (try.default false)) - (|> (/.find_type ["" name_1]) + (|> (/.type ["" name_1]) (/.run expected_lux) (try\map (\ type.equivalence = type_1)) (try.default false)) - (|> (/.find_type ["" name_2]) + (|> (/.type ["" name_2]) (/.run expected_lux) (try\map (\ type.equivalence = type_2)) (try.default false)) - (|> (/.find_type ["" name_3]) + (|> (/.type ["" name_3]) (/.run expected_lux) (try\map (\ type.equivalence = type_3)) (try.default false)) - (|> (/.find_type [current_module name_4]) + (|> (/.type [current_module name_4]) (/.run expected_lux) (try\map (\ type.equivalence = type_4)) (try.default false)) - (|> (/.find_type ["" name_4]) + (|> (/.type ["" name_4]) (/.run expected_lux) (try\map (\ type.equivalence = type_4)) (try.default false)))) @@ -873,7 +873,7 @@ (def: injection (Injection Meta) - (\ /.monad wrap)) + (\ /.monad in)) (def: (comparison init) (-> Lux (Comparison Meta)) diff --git a/stdlib/source/test/lux/program.lux b/stdlib/source/test/lux/program.lux index ec605af3b..15c7f2215 100644 --- a/stdlib/source/test/lux/program.lux +++ b/stdlib/source/test/lux/program.lux @@ -24,7 +24,7 @@ (syntax: (actual_program {actual_program (<| <code>.form (<>.after (<code>.text! "lux def program")) <code>.any)}) - (wrap (list actual_program))) + (in (list actual_program))) (def: #export test Test diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux index 5e96a2e02..fbbcc2414 100644 --- a/stdlib/source/test/lux/target/jvm.lux +++ b/stdlib/source/test/lux/target/jvm.lux @@ -90,9 +90,9 @@ [super_package (random.ascii/lower 10) package (random.ascii/lower 10) name (random.ascii/upper 10)] - (wrap (format super_package - /name.external_separator package - /name.external_separator name)))) + (in (format super_package + /name.external_separator package + /name.external_separator name)))) (def: (get_method name class) (-> Text (java/lang/Class java/lang/Object) java/lang/reflect/Method) @@ -107,31 +107,31 @@ (do random.monad [class_name ..class_name method_name (random.ascii/upper 10)] - (wrap (case (do try.monad - [class (/class.class /version.v6_0 /class.public - (/name.internal class_name) - (/name.internal "java.lang.Object") - (list) - (list) - (list (/method.method ..method_modifier - method_name - (/type.method [(list) (list) ..$Object (list)]) - (list) - (#.Some (do /.monad - [_ bytecode] - /.areturn)))) - (row.row)) - #let [bytecode (format.run /class.writer class) - loader (/loader.memory (/loader.new_library []))] - _ (/loader.define class_name bytecode loader) - class (io.run (/loader.load class_name loader)) - method (try (get_method method_name class))] - (java/lang/reflect/Method::invoke (ffi.null) (ffi.array java/lang/Object 0) method)) - (#try.Success actual) - (test actual) - - (#try.Failure error) - false)))) + (in (case (do try.monad + [class (/class.class /version.v6_0 /class.public + (/name.internal class_name) + (/name.internal "java.lang.Object") + (list) + (list) + (list (/method.method ..method_modifier + method_name + (/type.method [(list) (list) ..$Object (list)]) + (list) + (#.Some (do /.monad + [_ bytecode] + /.areturn)))) + (row.row)) + #let [bytecode (format.run /class.writer class) + loader (/loader.memory (/loader.new_library []))] + _ (/loader.define class_name bytecode loader) + class (io.run (/loader.load class_name loader)) + method (try (get_method method_name class))] + (java/lang/reflect/Method::invoke (ffi.null) (ffi.array java/lang/Object 0) method)) + (#try.Success actual) + (test actual) + + (#try.Failure error) + false)))) (type: (Primitive a) {#unboxed (Type category.Return) @@ -895,7 +895,7 @@ class (io.run (/loader.load class_name loader)) method (try (get_method static_method class)) output (java/lang/reflect/Method::invoke (ffi.null) (ffi.array java/lang/Object 0) method)] - (wrap (:as Int output))) + (in (:as Int output))) (#try.Success actual) (i.= (:as Int expected) (:as Int actual)) @@ -1326,46 +1326,46 @@ (random.only (|>> (text\= primitive_method_name) not))) expected (get@ #random primitive) #let [$Self (/type.class class_name (list))]] - (wrap (case (do try.monad - [class (/class.class /version.v6_0 /class.public - (/name.internal class_name) - (/name.internal "java.lang.Object") - (list) - (list) - (list (/method.method ..method_modifier - primitive_method_name - primitive_method_type - (list) - (#.Some (do /.monad - [_ ((get@ #literal primitive) expected)] - return))) - (/method.method ..method_modifier - object_method_name - (/type.method [(list) (list) (get@ #boxed primitive) (list)]) - (list) - (#.Some (do /.monad - [_ (/.invokestatic $Self primitive_method_name primitive_method_type) - _ (case substitute - #.None - (wrap []) + (in (case (do try.monad + [class (/class.class /version.v6_0 /class.public + (/name.internal class_name) + (/name.internal "java.lang.Object") + (list) + (list) + (list (/method.method ..method_modifier + primitive_method_name + primitive_method_type + (list) + (#.Some (do /.monad + [_ ((get@ #literal primitive) expected)] + return))) + (/method.method ..method_modifier + object_method_name + (/type.method [(list) (list) (get@ #boxed primitive) (list)]) + (list) + (#.Some (do /.monad + [_ (/.invokestatic $Self primitive_method_name primitive_method_type) + _ (case substitute + #.None + (in []) - (#.Some substitute) - (substitute expected)) - _ (get@ #wrap primitive)] - /.areturn)))) - (row.row)) - #let [bytecode (format.run /class.writer class) - loader (/loader.memory (/loader.new_library []))] - _ (/loader.define class_name bytecode loader) - class (io.run (/loader.load class_name loader)) - method (try (get_method object_method_name class))] - (java/lang/reflect/Method::invoke (ffi.null) (ffi.array java/lang/Object 0) method)) - (#try.Success actual) - (test expected actual) + (#.Some substitute) + (substitute expected)) + _ (get@ #wrap primitive)] + /.areturn)))) + (row.row)) + #let [bytecode (format.run /class.writer class) + loader (/loader.memory (/loader.new_library []))] + _ (/loader.define class_name bytecode loader) + class (io.run (/loader.load class_name loader)) + method (try (get_method object_method_name class))] + (java/lang/reflect/Method::invoke (ffi.null) (ffi.array java/lang/Object 0) method)) + (#try.Success actual) + (test expected actual) - (#try.Failure error) - false) - ))))] + (#try.Failure error) + false) + ))))] ($_ _.and (_.lift "IRETURN" (primitive_return ..$Integer::primitive /.ireturn #.None (!::= java/lang/Integer "jvm ieq" "jvm int ="))) (_.lift "LRETURN" (primitive_return ..$Long::primitive /.lreturn #.None (!::= java/lang/Long "jvm leq" "jvm long ="))) @@ -1712,7 +1712,7 @@ class (io.run (/loader.load concrete_class loader)) method (try (get_method static_method class)) output (java/lang/reflect/Method::invoke (ffi.null) (ffi.array java/lang/Object 0) method)] - (wrap (:as Int output))) + (in (:as Int output))) (#try.Success actual) (i.= (:as Int expected) (:as Int actual)) diff --git a/stdlib/source/test/lux/test.lux b/stdlib/source/test/lux/test.lux index 95004b2c4..e938dafd6 100644 --- a/stdlib/source/test/lux/test.lux +++ b/stdlib/source/test/lux/test.lux @@ -35,30 +35,30 @@ expected_message/1 (random.only (|>> (text\= expected_message/0) not) (random.ascii/lower 5))] ($_ /.and - (wrap (do async.monad - [[success_tally success_message] (/.assert expected_message/0 true) - [failure_tally failure_message] (/.assert expected_message/0 false)] - (/.cover' [/.assert /.Tally] - (and (text.ends_with? expected_message/0 success_message) - (text.ends_with? expected_message/0 failure_message) - (and (n.= 1 (get@ #/.successes success_tally)) - (n.= 0 (get@ #/.failures success_tally))) - (and (n.= 0 (get@ #/.successes failure_tally)) - (n.= 1 (get@ #/.failures failure_tally))))))) - (wrap (do async.monad - [tt (/.and' (/.assert expected_message/0 true) - (/.assert expected_message/1 true)) - ff (/.and' (/.assert expected_message/0 false) - (/.assert expected_message/1 false)) - tf (/.and' (/.assert expected_message/0 true) - (/.assert expected_message/1 false)) - ft (/.and' (/.assert expected_message/0 false) - (/.assert expected_message/1 true))] - (/.cover' [/.and'] - (and (..verify expected_message/0 expected_message/1 2 0 tt) - (..verify expected_message/0 expected_message/1 0 2 ff) - (..verify expected_message/0 expected_message/1 1 1 tf) - (..verify expected_message/0 expected_message/1 1 1 ft))))) + (in (do async.monad + [[success_tally success_message] (/.assert expected_message/0 true) + [failure_tally failure_message] (/.assert expected_message/0 false)] + (/.cover' [/.assert /.Tally] + (and (text.ends_with? expected_message/0 success_message) + (text.ends_with? expected_message/0 failure_message) + (and (n.= 1 (get@ #/.successes success_tally)) + (n.= 0 (get@ #/.failures success_tally))) + (and (n.= 0 (get@ #/.successes failure_tally)) + (n.= 1 (get@ #/.failures failure_tally))))))) + (in (do async.monad + [tt (/.and' (/.assert expected_message/0 true) + (/.assert expected_message/1 true)) + ff (/.and' (/.assert expected_message/0 false) + (/.assert expected_message/1 false)) + tf (/.and' (/.assert expected_message/0 true) + (/.assert expected_message/1 false)) + ft (/.and' (/.assert expected_message/0 false) + (/.assert expected_message/1 true))] + (/.cover' [/.and'] + (and (..verify expected_message/0 expected_message/1 2 0 tt) + (..verify expected_message/0 expected_message/1 0 2 ff) + (..verify expected_message/0 expected_message/1 1 1 tf) + (..verify expected_message/0 expected_message/1 1 1 ft))))) ))) (def: seed @@ -75,45 +75,45 @@ post (<| (/.seed seed) (do ! [actual random.nat] - (wrap (do async.monad - [expected read] - (/.assert "" (n.= expected actual))))))] - (wrap (do async.monad - [[pre_tally pre_message] pre - [post_tally post_message] post] - (/.cover' [/.seed] - (and (and (n.= 1 (get@ #/.successes pre_tally)) - (n.= 0 (get@ #/.failures pre_tally))) - (and (n.= 1 (get@ #/.successes post_tally)) - (n.= 0 (get@ #/.failures post_tally))))))))) + (in (do async.monad + [expected read] + (/.assert "" (n.= expected actual))))))] + (in (do async.monad + [[pre_tally pre_message] pre + [post_tally post_message] post] + (/.cover' [/.seed] + (and (and (n.= 1 (get@ #/.successes pre_tally)) + (n.= 0 (get@ #/.failures pre_tally))) + (and (n.= 1 (get@ #/.successes post_tally)) + (n.= 0 (get@ #/.failures post_tally))))))))) (def: times /.Test ($_ /.and (do {! random.monad} [times_assertion (/.times 0 (/.test "" true))] - (wrap (do async.monad - [[tally error] times_assertion] - (/.cover' [/.must_try_test_at_least_once] - (and (text.contains? (get@ #exception.label /.must_try_test_at_least_once) error) - (n.= 0 (get@ #/.successes tally)) - (n.= 1 (get@ #/.failures tally))))))) + (in (do async.monad + [[tally error] times_assertion] + (/.cover' [/.must_try_test_at_least_once] + (and (text.contains? (get@ #exception.label /.must_try_test_at_least_once) error) + (n.= 0 (get@ #/.successes tally)) + (n.= 1 (get@ #/.failures tally))))))) (do {! random.monad} [expected (\ ! map (|>> (n.% 10) inc) random.nat) #let [counter (: (Atom Nat) (atom.atom 0))] times_assertion (<| (/.times expected) (do ! - [_ (wrap []) + [_ (in []) #let [_ (io.run (atom.update inc counter))]] (/.test "" true)))] - (wrap (do async.monad - [[tally error] times_assertion - actual (async.future (atom.read counter))] - (/.cover' [/.times] - (and (n.= expected actual) - (n.= 1 (get@ #/.successes tally)) - (n.= 0 (get@ #/.failures tally))))))) + (in (do async.monad + [[tally error] times_assertion + actual (async.future (atom.read counter))] + (/.cover' [/.times] + (and (n.= expected actual) + (n.= 1 (get@ #/.successes tally)) + (n.= 0 (get@ #/.failures tally))))))) )) (def: in_parallel @@ -127,16 +127,16 @@ (list.repeat expected) (: /.Test) (do ! - [_ (wrap []) + [_ (in []) #let [_ (io.run (atom.update inc counter))]] (/.test "" true)))] - (wrap (do async.monad - [[tally error] assertion - actual (async.future (atom.read counter))] - (/.cover' [/.in_parallel] - (and (n.= expected actual) - (n.= expected (get@ #/.successes tally)) - (n.= 0 (get@ #/.failures tally))))))) + (in (do async.monad + [[tally error] assertion + actual (async.future (atom.read counter))] + (/.cover' [/.in_parallel] + (and (n.= expected actual) + (n.= expected (get@ #/.successes tally)) + (n.= 0 (get@ #/.failures tally))))))) (do {! random.monad} [expected (\ ! map (|>> (n.% 10) inc) random.nat) #let [counter (: (Atom Nat) @@ -145,22 +145,22 @@ (list.repeat expected) (: /.Test) (do ! - [_ (wrap []) + [_ (in []) #let [_ (undefined) _ (io.run (atom.update inc counter))]] (/.test "" true)))] - (wrap (do async.monad - [[tally error] assertion - actual (async.future (atom.read counter))] - (/.cover' [/.error_during_execution] - (let [correct_error! (text.contains? (get@ #exception.label /.error_during_execution) error) - no_complete_run! (n.= 0 actual) - no_successes! (n.= 0 (get@ #/.successes tally)) - ran_all_tests! (n.= expected (get@ #/.failures tally))] - (and correct_error! - no_complete_run! - no_successes! - ran_all_tests!)))))) + (in (do async.monad + [[tally error] assertion + actual (async.future (atom.read counter))] + (/.cover' [/.error_during_execution] + (let [correct_error! (text.contains? (get@ #exception.label /.error_during_execution) error) + no_complete_run! (n.= 0 actual) + no_successes! (n.= 0 (get@ #/.successes tally)) + ran_all_tests! (n.= expected (get@ #/.failures tally))] + (and correct_error! + no_complete_run! + no_successes! + ran_all_tests!)))))) )) (def: #export dummy_target @@ -172,47 +172,47 @@ (do random.monad [not_covering (/.test "" true) covering (/.covering .._ (/.test "" true))] - (wrap (do async.monad - [[not_covering _] not_covering - [covering _] covering] - (/.cover' [/.covering] - (and (and (set.empty? (get@ #/.expected_coverage not_covering)) - (set.empty? (get@ #/.actual_coverage not_covering))) - (and (not (set.empty? (get@ #/.expected_coverage covering))) - (set.empty? (get@ #/.actual_coverage covering)))))))) + (in (do async.monad + [[not_covering _] not_covering + [covering _] covering] + (/.cover' [/.covering] + (and (and (set.empty? (get@ #/.expected_coverage not_covering)) + (set.empty? (get@ #/.actual_coverage not_covering))) + (and (not (set.empty? (get@ #/.expected_coverage covering))) + (set.empty? (get@ #/.actual_coverage covering)))))))) (do random.monad [not_covering (/.covering .._ (/.test "" true)) covering (/.covering .._ (/.cover [..dummy_target] true))] - (wrap (do async.monad - [[not_covering _] not_covering - [covering _] covering] - (/.cover' [/.cover] - (and (and (not (set.empty? (get@ #/.expected_coverage not_covering))) - (not (set.member? (get@ #/.actual_coverage not_covering) (name_of ..dummy_target)))) - (and (not (set.empty? (get@ #/.expected_coverage covering))) - (set.member? (get@ #/.actual_coverage covering) (name_of ..dummy_target)))))))) + (in (do async.monad + [[not_covering _] not_covering + [covering _] covering] + (/.cover' [/.cover] + (and (and (not (set.empty? (get@ #/.expected_coverage not_covering))) + (not (set.member? (get@ #/.actual_coverage not_covering) (name_of ..dummy_target)))) + (and (not (set.empty? (get@ #/.expected_coverage covering))) + (set.member? (get@ #/.actual_coverage covering) (name_of ..dummy_target)))))))) (do random.monad [not_covering (/.covering .._ (/.test "" true)) - covering (/.covering .._ (wrap (/.cover' [..dummy_target] true)))] - (wrap (do async.monad - [[not_covering _] not_covering - [covering _] covering] - (/.cover' [/.cover'] - (and (and (not (set.empty? (get@ #/.expected_coverage not_covering))) - (not (set.member? (get@ #/.actual_coverage not_covering) (name_of ..dummy_target)))) - (and (not (set.empty? (get@ #/.expected_coverage covering))) - (set.member? (get@ #/.actual_coverage covering) (name_of ..dummy_target)))))))) + covering (/.covering .._ (in (/.cover' [..dummy_target] true)))] + (in (do async.monad + [[not_covering _] not_covering + [covering _] covering] + (/.cover' [/.cover'] + (and (and (not (set.empty? (get@ #/.expected_coverage not_covering))) + (not (set.member? (get@ #/.actual_coverage not_covering) (name_of ..dummy_target)))) + (and (not (set.empty? (get@ #/.expected_coverage covering))) + (set.member? (get@ #/.actual_coverage covering) (name_of ..dummy_target)))))))) (do random.monad [not_covering (/.covering .._ (/.test "" true)) covering (/.covering .._ (/.for [..dummy_target] (/.test "" true)))] - (wrap (do async.monad - [[not_covering _] not_covering - [covering _] covering] - (/.cover' [/.for] - (and (and (not (set.empty? (get@ #/.expected_coverage not_covering))) - (not (set.member? (get@ #/.actual_coverage not_covering) (name_of ..dummy_target)))) - (and (not (set.empty? (get@ #/.expected_coverage covering))) - (set.member? (get@ #/.actual_coverage covering) (name_of ..dummy_target)))))))) + (in (do async.monad + [[not_covering _] not_covering + [covering _] covering] + (/.cover' [/.for] + (and (and (not (set.empty? (get@ #/.expected_coverage not_covering))) + (not (set.member? (get@ #/.actual_coverage not_covering) (name_of ..dummy_target)))) + (and (not (set.empty? (get@ #/.expected_coverage covering))) + (set.member? (get@ #/.actual_coverage covering) (name_of ..dummy_target)))))))) )) (def: #export test @@ -233,16 +233,16 @@ (do ! [success_assertion (/.test expected_message/0 true) failure_assertion (/.test expected_message/0 false)] - (wrap (do async.monad - [[success_tally success_message] success_assertion - [failure_tally failure_message] failure_assertion] - (/.cover' [/.test] - (and (text.ends_with? expected_message/0 success_message) - (text.ends_with? expected_message/0 failure_message) - (and (n.= 1 (get@ #/.successes success_tally)) - (n.= 0 (get@ #/.failures success_tally))) - (and (n.= 0 (get@ #/.successes failure_tally)) - (n.= 1 (get@ #/.failures failure_tally)))))))) + (in (do async.monad + [[success_tally success_message] success_assertion + [failure_tally failure_message] failure_assertion] + (/.cover' [/.test] + (and (text.ends_with? expected_message/0 success_message) + (text.ends_with? expected_message/0 failure_message) + (and (n.= 1 (get@ #/.successes success_tally)) + (n.= 0 (get@ #/.failures success_tally))) + (and (n.= 0 (get@ #/.successes failure_tally)) + (n.= 1 (get@ #/.failures failure_tally)))))))) (do ! [tt (/.and (/.test expected_message/0 true) (/.test expected_message/1 true)) @@ -252,52 +252,52 @@ (/.test expected_message/1 false)) ft (/.and (/.test expected_message/0 false) (/.test expected_message/1 true))] - (wrap (do async.monad - [tt tt - ff ff - tf tf - ft ft] - (/.cover' [/.and] - (and (..verify expected_message/0 expected_message/1 2 0 tt) - (..verify expected_message/0 expected_message/1 0 2 ff) - (..verify expected_message/0 expected_message/1 1 1 tf) - (..verify expected_message/0 expected_message/1 1 1 ft)))))) + (in (do async.monad + [tt tt + ff ff + tf tf + ft ft] + (/.cover' [/.and] + (and (..verify expected_message/0 expected_message/1 2 0 tt) + (..verify expected_message/0 expected_message/1 0 2 ff) + (..verify expected_message/0 expected_message/1 1 1 tf) + (..verify expected_message/0 expected_message/1 1 1 ft)))))) (do ! [success_assertion (/.context expected_context (/.test expected_message/0 true)) failure_assertion (/.context expected_context (/.test expected_message/0 false))] - (wrap (do async.monad - [[success_tally success_message] success_assertion - [failure_tally failure_message] failure_assertion] - (/.cover' [/.context] - (and (and (text.contains? expected_context success_message) - (text.contains? expected_message/0 success_message)) - (and (text.contains? expected_context failure_message) - (text.contains? expected_message/0 failure_message)) - (and (n.= 1 (get@ #/.successes success_tally)) - (n.= 0 (get@ #/.failures success_tally))) - (and (n.= 0 (get@ #/.successes failure_tally)) - (n.= 1 (get@ #/.failures failure_tally)))))))) + (in (do async.monad + [[success_tally success_message] success_assertion + [failure_tally failure_message] failure_assertion] + (/.cover' [/.context] + (and (and (text.contains? expected_context success_message) + (text.contains? expected_message/0 success_message)) + (and (text.contains? expected_context failure_message) + (text.contains? expected_message/0 failure_message)) + (and (n.= 1 (get@ #/.successes success_tally)) + (n.= 0 (get@ #/.failures success_tally))) + (and (n.= 0 (get@ #/.successes failure_tally)) + (n.= 1 (get@ #/.failures failure_tally)))))))) (do ! [failure_assertion (/.failure expected_message/0)] - (wrap (do async.monad - [[failure_tally failure_message] failure_assertion] - (/.cover' [/.failure] - (and (text.contains? expected_message/0 failure_message) - (and (n.= 0 (get@ #/.successes failure_tally)) - (n.= 1 (get@ #/.failures failure_tally)))))))) + (in (do async.monad + [[failure_tally failure_message] failure_assertion] + (/.cover' [/.failure] + (and (text.contains? expected_message/0 failure_message) + (and (n.= 0 (get@ #/.successes failure_tally)) + (n.= 1 (get@ #/.failures failure_tally)))))))) (do ! - [success_assertion (/.lift expected_message/0 (wrap true)) - failure_assertion (/.lift expected_message/0 (wrap false))] - (wrap (do async.monad - [[success_tally success_message] success_assertion - [failure_tally failure_message] failure_assertion] - (/.cover' [/.lift] - (and (text.contains? expected_message/0 success_message) - (text.contains? expected_message/0 failure_message) - (and (n.= 1 (get@ #/.successes success_tally)) - (n.= 0 (get@ #/.failures success_tally))) - (and (n.= 0 (get@ #/.successes failure_tally)) - (n.= 1 (get@ #/.failures failure_tally)))))))) + [success_assertion (/.lift expected_message/0 (in true)) + failure_assertion (/.lift expected_message/0 (in false))] + (in (do async.monad + [[success_tally success_message] success_assertion + [failure_tally failure_message] failure_assertion] + (/.cover' [/.lift] + (and (text.contains? expected_message/0 success_message) + (text.contains? expected_message/0 failure_message) + (and (n.= 1 (get@ #/.successes success_tally)) + (n.= 0 (get@ #/.failures success_tally))) + (and (n.= 0 (get@ #/.successes failure_tally)) + (n.= 1 (get@ #/.failures failure_tally)))))))) ..times ..in_parallel ..coverage diff --git a/stdlib/source/test/lux/time/day.lux b/stdlib/source/test/lux/time/day.lux index 03544b180..000b5d6e7 100644 --- a/stdlib/source/test/lux/time/day.lux +++ b/stdlib/source/test/lux/time/day.lux @@ -19,13 +19,13 @@ (def: #export random (Random /.Day) - (random.either (random.either (random.either (random\wrap #/.Sunday) - (random\wrap #/.Monday)) - (random.either (random\wrap #/.Tuesday) - (random\wrap #/.Wednesday))) - (random.either (random.either (random\wrap #/.Thursday) - (random\wrap #/.Friday)) - (random\wrap #/.Saturday)))) + (random.either (random.either (random.either (random\in #/.Sunday) + (random\in #/.Monday)) + (random.either (random\in #/.Tuesday) + (random\in #/.Wednesday))) + (random.either (random.either (random\in #/.Thursday) + (random\in #/.Friday)) + (random\in #/.Saturday)))) (def: #export test Test diff --git a/stdlib/source/test/lux/time/month.lux b/stdlib/source/test/lux/time/month.lux index 317783047..3e2a8b451 100644 --- a/stdlib/source/test/lux/time/month.lux +++ b/stdlib/source/test/lux/time/month.lux @@ -52,8 +52,8 @@ (do random.monad [expected ..random - invalid (random.only (predicate.unite (n.< (/.number #/.January)) - (n.> (/.number #/.December))) + invalid (random.only (predicate.or (n.< (/.number #/.January)) + (n.> (/.number #/.December))) random.nat)] ($_ _.and (_.cover [/.number /.by_number] diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/case.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/case.lux index 31507f067..0c1d1a712 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/case.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/case.lux @@ -50,13 +50,13 @@ (do list.monad [tail+ (exhaustive_weaving tail++) head head+] - (wrap (#.Cons head tail+))))) + (in (#.Cons head tail+))))) (def: #export (exhaustive_branches allow_literals? variantTC inputC) (-> Bit (List [Code Code]) Code (Random (List Code))) (case inputC [_ (#.Bit _)] - (r\wrap (list (' #0) (' #1))) + (r\in (list (' #0) (' #1))) (^template [<tag> <gen> <wrapper>] [[_ (<tag> _)] @@ -67,11 +67,11 @@ (#.Some sample) (do ! [else (exhaustive_branches allow_literals? variantTC inputC)] - (wrap (list& (<wrapper> sample) else))) + (in (list& (<wrapper> sample) else))) #.None - (wrap (list (' _))))) - (r\wrap (list (' _))))]) + (in (list (' _))))) + (r\in (list (' _))))]) ([#.Nat r.nat code.nat] [#.Int r.int code.int] [#.Rev r.rev code.rev] @@ -79,26 +79,26 @@ [#.Text (r.unicode 5) code.text]) (^ [_ (#.Tuple (list))]) - (r\wrap (list (' []))) + (r\in (list (' []))) [_ (#.Tuple members)] (do {! r.monad} [member_wise_patterns (monad.map ! (exhaustive_branches allow_literals? variantTC) members)] - (wrap (|> member_wise_patterns - exhaustive_weaving - (list\map code.tuple)))) + (in (|> member_wise_patterns + exhaustive_weaving + (list\map code.tuple)))) (^ [_ (#.Record (list))]) - (r\wrap (list (' {}))) + (r\in (list (' {}))) [_ (#.Record kvs)] (do {! r.monad} [#let [ks (list\map product.left kvs) vs (list\map product.right kvs)] member_wise_patterns (monad.map ! (exhaustive_branches allow_literals? variantTC) vs)] - (wrap (|> member_wise_patterns - exhaustive_weaving - (list\map (|>> (list.zipped/2 ks) code.record))))) + (in (|> member_wise_patterns + exhaustive_weaving + (list\map (|>> (list.zipped/2 ks) code.record))))) (^ [_ (#.Form (list [_ (#.Tag _)] _))]) (do {! r.monad} @@ -106,13 +106,13 @@ (function (_ [_tag _code]) (do ! [v_branches (exhaustive_branches allow_literals? variantTC _code)] - (wrap (list\map (function (_ pattern) (` ((~ _tag) (~ pattern)))) - v_branches)))) + (in (list\map (function (_ pattern) (` ((~ _tag) (~ pattern)))) + v_branches)))) variantTC)] - (wrap (list\join bundles))) + (in (list\join bundles))) _ - (r\wrap (list)) + (r\in (list)) )) (def: #export (input variant_tags record_tags primitivesC) @@ -125,12 +125,12 @@ [choice (|> r.nat (\ ! map (n.% (list.size variant_tags)))) #let [choiceT (maybe.assume (list.nth choice variant_tags)) choiceC (maybe.assume (list.nth choice primitivesC))]] - (wrap (` ((~ choiceT) (~ choiceC))))) + (in (` ((~ choiceT) (~ choiceC))))) (do {! r.monad} [size (|> r.nat (\ ! map (n.% 3))) elems (r.list size input)] - (wrap (code.tuple elems))) - (r\wrap (code.record (list.zipped/2 record_tags primitivesC))) + (in (code.tuple elems))) + (r\in (code.record (list.zipped/2 record_tags primitivesC))) )))) (def: (branch body pattern) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/primitive.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/primitive.lux index e3b4ad9ad..7fb549845 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/primitive.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/primitive.lux @@ -54,9 +54,9 @@ (Random [Type Code]) (`` ($_ r.either (~~ (template [<type> <code_wrapper> <value_gen>] - [(r.and (r\wrap <type>) (r\map <code_wrapper> <value_gen>))] + [(r.and (r\in <type>) (r\map <code_wrapper> <value_gen>))] - [Any code.tuple (r.list 0 (r\wrap (' [])))] + [Any code.tuple (r.list 0 (r\in (' [])))] [Bit code.bit r.bit] [Nat code.nat r.nat] [Int code.int r.int] @@ -78,7 +78,7 @@ (case> (#try.Success [inferred_type output]) (if (is? expected_type inferred_type) (#try.Success output) - (exception.throw wrong_inference [expected_type inferred_type])) + (exception.except wrong_inference [expected_type inferred_type])) (#try.Failure error) (#try.Failure error)))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/reference.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/reference.lux index d854d5677..e1f52e584 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/reference.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/reference.lux @@ -56,7 +56,7 @@ (do ! [_ (if import? (//module.import def_module) - (wrap []))] + (in []))] (//type.with_inference (_primitive.phase archive.empty (code.identifier [def_module var_name])))))) (phase.run _primitive.state) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/case.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/case.lux index ae8292476..8eed2d440 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/case.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/case.lux @@ -112,9 +112,9 @@ (do {! random.monad} [lefts (|> random.nat (\ ! map (n.% 10))) right? random.bit] - (wrap (if right? - (#.Right lefts) - (#.Left lefts))))) + (in (if right? + (#.Right lefts) + (#.Left lefts))))) (def: random-path (Random (analysis.Tuple synthesis.Member)) @@ -127,20 +127,20 @@ (Random [analysis.Pattern Register])) (do random.monad [@member random.nat] - (wrap [(list\fold (function (_ member inner) - (case member - (#.Left lefts) - (analysis.pattern/tuple - (list\compose (list.repeat lefts (analysis.pattern/unit)) - (list inner (analysis.pattern/unit)))) - - (#.Right lefts) - (analysis.pattern/tuple - (list\compose (list.repeat (inc lefts) (analysis.pattern/unit)) - (list inner))))) - (#analysis.Bind @member) - (list.reverse path)) - @member]))) + (in [(list\fold (function (_ member inner) + (case member + (#.Left lefts) + (analysis.pattern/tuple + (list\compose (list.repeat lefts (analysis.pattern/unit)) + (list inner (analysis.pattern/unit)))) + + (#.Right lefts) + (analysis.pattern/tuple + (list\compose (list.repeat (inc lefts) (analysis.pattern/unit)) + (list inner))))) + (#analysis.Bind @member) + (list.reverse path)) + @member]))) (def: get-test Test @@ -171,14 +171,14 @@ [test random.bit then random.nat else random.nat] - (wrap [(#synthesis.Alt (#synthesis.Seq (synthesis.path/bit test) - (#synthesis.Then (synthesis.i64 (.i64 then)))) - (#synthesis.Seq (synthesis.path/bit (not test)) - (#synthesis.Then (synthesis.i64 (.i64 else))))) - [{#analysis.when (analysis.pattern/bit test) - #analysis.then (analysis.nat then)} - (list {#analysis.when (analysis.pattern/bit (not test)) - #analysis.then (analysis.nat else)})]]))) + (in [(#synthesis.Alt (#synthesis.Seq (synthesis.path/bit test) + (#synthesis.Then (synthesis.i64 (.i64 then)))) + (#synthesis.Seq (synthesis.path/bit (not test)) + (#synthesis.Then (synthesis.i64 (.i64 else))))) + [{#analysis.when (analysis.pattern/bit test) + #analysis.then (analysis.nat then)} + (list {#analysis.when (analysis.pattern/bit (not test)) + #analysis.then (analysis.nat else)})]]))) (def: (random-five hash random-element) (All [a] (-> (Hash a) (Random a) (Random [a a a a a]))) @@ -197,17 +197,17 @@ (do {! random.monad} [[test/0 test/1 test/2 test/3 test/4] (random-five <hash> <random>) [body/0 body/1 body/2 body/3 body/4] (random-five <hash> <random>)] - (wrap [($_ #synthesis.Alt - (#synthesis.Seq (<path> test/0) (#synthesis.Then (<synthesis> body/0))) - (#synthesis.Seq (<path> test/1) (#synthesis.Then (<synthesis> body/1))) - (#synthesis.Seq (<path> test/2) (#synthesis.Then (<synthesis> body/2))) - (#synthesis.Seq (<path> test/3) (#synthesis.Then (<synthesis> body/3))) - (#synthesis.Seq (<path> test/4) (#synthesis.Then (<synthesis> body/4)))) - [{#analysis.when (<pattern> test/0) #analysis.then (<analysis> body/0)} - (list {#analysis.when (<pattern> test/1) #analysis.then (<analysis> body/1)} - {#analysis.when (<pattern> test/2) #analysis.then (<analysis> body/2)} - {#analysis.when (<pattern> test/3) #analysis.then (<analysis> body/3)} - {#analysis.when (<pattern> test/4) #analysis.then (<analysis> body/4)})]])))] + (in [($_ #synthesis.Alt + (#synthesis.Seq (<path> test/0) (#synthesis.Then (<synthesis> body/0))) + (#synthesis.Seq (<path> test/1) (#synthesis.Then (<synthesis> body/1))) + (#synthesis.Seq (<path> test/2) (#synthesis.Then (<synthesis> body/2))) + (#synthesis.Seq (<path> test/3) (#synthesis.Then (<synthesis> body/3))) + (#synthesis.Seq (<path> test/4) (#synthesis.Then (<synthesis> body/4)))) + [{#analysis.when (<pattern> test/0) #analysis.then (<analysis> body/0)} + (list {#analysis.when (<pattern> test/1) #analysis.then (<analysis> body/1)} + {#analysis.when (<pattern> test/2) #analysis.then (<analysis> body/2)} + {#analysis.when (<pattern> test/3) #analysis.then (<analysis> body/3)} + {#analysis.when (<pattern> test/4) #analysis.then (<analysis> body/4)})]])))] [random-nat n.hash random.nat (|>> .i64 synthesis.path/i64) (|>> .i64 synthesis.i64) analysis.pattern/nat analysis.nat] [random-int int.hash random.int (|>> .i64 synthesis.path/i64) (|>> .i64 synthesis.i64) analysis.pattern/int analysis.int] @@ -247,17 +247,17 @@ #analysis.right? right? #analysis.value (analysis.pattern/text value)}) #analysis.then (analysis.frac body)}))]] - (wrap [($_ #synthesis.Alt - (path lefts/0 false value/0 body/0) - (path lefts/1 false value/1 body/1) - (path lefts/2 false value/2 body/2) - (path lefts/3 false value/3 body/3) - (path lefts/4 last-is-right? value/4 body/4)) - [(branch lefts/0 false value/0 body/0) - (list (branch lefts/1 false value/1 body/1) - (branch lefts/2 false value/2 body/2) - (branch lefts/3 false value/3 body/3) - (branch lefts/4 last-is-right? value/4 body/4))]]))) + (in [($_ #synthesis.Alt + (path lefts/0 false value/0 body/0) + (path lefts/1 false value/1 body/1) + (path lefts/2 false value/2 body/2) + (path lefts/3 false value/3 body/3) + (path lefts/4 last-is-right? value/4 body/4)) + [(branch lefts/0 false value/0 body/0) + (list (branch lefts/1 false value/1 body/1) + (branch lefts/2 false value/2 body/2) + (branch lefts/3 false value/3 body/3) + (branch lefts/4 last-is-right? value/4 body/4))]]))) (def: random-tuple (Random [Path Match]) @@ -297,21 +297,21 @@ (list (analysis.pattern/text value) (analysis.pattern/unit))))) #analysis.then (analysis.frac body)}))]] - (wrap [(list\fold (function (_ left right) - (#synthesis.Alt left right)) - (path (inc mid-size) true value/last body/last) - (|> (list.zipped/2 value/mid body/mid) - (#.Cons [value/first body/first]) - list.enumeration - (list\map (function (_ [lefts' [value body]]) - (path lefts' false value body))) - list.reverse)) - [(branch 0 false value/first body/first) - (list\compose (|> (list.zipped/2 value/mid body/mid) - list.enumeration - (list\map (function (_ [lefts' [value body]]) - (branch (inc lefts') false value body)))) - (list (branch (inc mid-size) true value/last body/last)))]]))) + (in [(list\fold (function (_ left right) + (#synthesis.Alt left right)) + (path (inc mid-size) true value/last body/last) + (|> (list.zipped/2 value/mid body/mid) + (#.Cons [value/first body/first]) + list.enumeration + (list\map (function (_ [lefts' [value body]]) + (path lefts' false value body))) + list.reverse)) + [(branch 0 false value/first body/first) + (list\compose (|> (list.zipped/2 value/mid body/mid) + list.enumeration + (list\map (function (_ [lefts' [value body]]) + (branch (inc lefts') false value body)))) + (list (branch (inc mid-size) true value/last body/last)))]]))) (def: random-complex ($_ random.either diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/function.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/function.lux index d07a63f00..63d9d9d20 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/function.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/function.lux @@ -80,7 +80,7 @@ (def: (random-unit output?) Scenario - (\ random.monad wrap + (\ random.monad in [true (synthesis.text synthesis.unit) (analysis.unit)])) @@ -90,9 +90,9 @@ Scenario (do {! random.monad} [value <random>] - (wrap [true - (<synthesis> value) - (<analysis> value)])))] + (in [true + (<synthesis> value) + (<analysis> value)])))] [random-bit random.bit synthesis.bit analysis.bit] [random-nat random.nat (|>> .i64 synthesis.i64) analysis.nat] @@ -118,25 +118,25 @@ [lefts random.nat right? random.bit [loop? expected-value actual-value] (random-value false)] - (wrap [loop? - (synthesis.variant - {#analysis.lefts lefts - #analysis.right? right? - #analysis.value expected-value}) - (analysis.variant - {#analysis.lefts lefts - #analysis.right? right? - #analysis.value actual-value})]))) + (in [loop? + (synthesis.variant + {#analysis.lefts lefts + #analysis.right? right? + #analysis.value expected-value}) + (analysis.variant + {#analysis.lefts lefts + #analysis.right? right? + #analysis.value actual-value})]))) (def: (random-tuple random-value output?) (-> Scenario Scenario) (do {! random.monad} [[loop?-left expected-left actual-left] (random-value false) [loop?-right expected-right actual-right] (random-value false)] - (wrap [(and loop?-left - loop?-right) - (synthesis.tuple (list expected-left expected-right)) - (analysis.tuple (list actual-left actual-right))]))) + (in [(and loop?-left + loop?-right) + (synthesis.tuple (list expected-left expected-right)) + (analysis.tuple (list actual-left actual-right))]))) (def: (random-structure random-value output?) (-> Scenario Scenario) @@ -148,20 +148,20 @@ (-> Arity Scenario) (do {! random.monad} [register (\ ! map (|>> (n.% arity) inc) random.nat)] - (wrap [(not (n.= 0 register)) - (synthesis.variable/local register) - (if (n.= arity register) - (#analysis.Reference (reference.local 1)) - (#analysis.Reference (reference.foreign register)))]))) + (in [(not (n.= 0 register)) + (synthesis.variable/local register) + (if (n.= arity register) + (#analysis.Reference (reference.local 1)) + (#analysis.Reference (reference.foreign register)))]))) (def: (random-constant output?) Scenario (do {! random.monad} [module (random.unicode 1) short (random.unicode 1)] - (wrap [true - (synthesis.constant [module short]) - (#analysis.Reference (reference.constant [module short]))]))) + (in [true + (synthesis.constant [module short]) + (#analysis.Reference (reference.constant [module short]))]))) (def: (random-reference arity output?) (-> Arity Scenario) @@ -182,74 +182,74 @@ #let [side|member (if right? (#.Right lefts) (#.Left lefts))]] - (wrap [(and loop?-input - loop?-output) - (synthesis.branch/case [expected-input - ($_ synthesis.path/alt - (synthesis.path/then expected-output) - (synthesis.path/seq (synthesis.path/bit bit-test) - (synthesis.path/then expected-output)) - (synthesis.path/seq (synthesis.path/i64 (.i64 i64-test)) - (synthesis.path/then expected-output)) - (synthesis.path/seq (synthesis.path/f64 f64-test) - (synthesis.path/then expected-output)) - (synthesis.path/seq (synthesis.path/text text-test) - (synthesis.path/then expected-output)) - (synthesis.path/seq (synthesis.path/bind (inc arity)) - (synthesis.path/then expected-output)) + (in [(and loop?-input + loop?-output) + (synthesis.branch/case [expected-input + ($_ synthesis.path/alt + (synthesis.path/then expected-output) + (synthesis.path/seq (synthesis.path/bit bit-test) + (synthesis.path/then expected-output)) + (synthesis.path/seq (synthesis.path/i64 (.i64 i64-test)) + (synthesis.path/then expected-output)) + (synthesis.path/seq (synthesis.path/f64 f64-test) + (synthesis.path/then expected-output)) + (synthesis.path/seq (synthesis.path/text text-test) + (synthesis.path/then expected-output)) + (synthesis.path/seq (synthesis.path/bind (inc arity)) + (synthesis.path/then expected-output)) + ($_ synthesis.path/seq + (synthesis.path/side side|member) + (synthesis.path/bind (inc arity)) + (synthesis.path/then expected-output)) + (if right? ($_ synthesis.path/seq - (synthesis.path/side side|member) + (synthesis.path/member side|member) (synthesis.path/bind (inc arity)) - (synthesis.path/then expected-output)) - (if right? - ($_ synthesis.path/seq - (synthesis.path/member side|member) - (synthesis.path/bind (inc arity)) - (synthesis.path/then expected-output)) - ($_ synthesis.path/seq - (synthesis.path/member side|member) - (synthesis.path/bind (inc arity)) - synthesis.path/pop - (synthesis.path/then expected-output))))]) - (#analysis.Case actual-input - [{#analysis.when (analysis.pattern/unit) - #analysis.then actual-output} - (list {#analysis.when (analysis.pattern/bit bit-test) - #analysis.then actual-output} - {#analysis.when (analysis.pattern/nat (.nat i64-test)) - #analysis.then actual-output} - {#analysis.when (analysis.pattern/frac f64-test) - #analysis.then actual-output} - {#analysis.when (analysis.pattern/text text-test) - #analysis.then actual-output} - {#analysis.when (#analysis.Bind 2) - #analysis.then actual-output} - {#analysis.when (analysis.pattern/variant - {#analysis.lefts lefts - #analysis.right? right? - #analysis.value (#analysis.Bind 2)}) - #analysis.then actual-output} - {#analysis.when (analysis.pattern/tuple - (list\compose (list.repeat lefts (analysis.pattern/unit)) - (if right? - (list (analysis.pattern/unit) (#analysis.Bind 2)) - (list (#analysis.Bind 2) (analysis.pattern/unit))))) - #analysis.then actual-output})])]))) + (synthesis.path/then expected-output)) + ($_ synthesis.path/seq + (synthesis.path/member side|member) + (synthesis.path/bind (inc arity)) + synthesis.path/pop + (synthesis.path/then expected-output))))]) + (#analysis.Case actual-input + [{#analysis.when (analysis.pattern/unit) + #analysis.then actual-output} + (list {#analysis.when (analysis.pattern/bit bit-test) + #analysis.then actual-output} + {#analysis.when (analysis.pattern/nat (.nat i64-test)) + #analysis.then actual-output} + {#analysis.when (analysis.pattern/frac f64-test) + #analysis.then actual-output} + {#analysis.when (analysis.pattern/text text-test) + #analysis.then actual-output} + {#analysis.when (#analysis.Bind 2) + #analysis.then actual-output} + {#analysis.when (analysis.pattern/variant + {#analysis.lefts lefts + #analysis.right? right? + #analysis.value (#analysis.Bind 2)}) + #analysis.then actual-output} + {#analysis.when (analysis.pattern/tuple + (list\compose (list.repeat lefts (analysis.pattern/unit)) + (if right? + (list (analysis.pattern/unit) (#analysis.Bind 2)) + (list (#analysis.Bind 2) (analysis.pattern/unit))))) + #analysis.then actual-output})])]))) (def: (random-let arity random-value output?) (-> Arity Scenario Scenario) (do {! random.monad} [[loop?-input expected-input actual-input] (random-value false) [loop?-output expected-output actual-output] (random-value output?)] - (wrap [(and loop?-input - loop?-output) - (synthesis.branch/let [expected-input - (inc arity) - expected-output]) - (#analysis.Case actual-input - [{#analysis.when (#analysis.Bind 2) - #analysis.then actual-output} - (list)])]))) + (in [(and loop?-input + loop?-output) + (synthesis.branch/let [expected-input + (inc arity) + expected-output]) + (#analysis.Case actual-input + [{#analysis.when (#analysis.Bind 2) + #analysis.then actual-output} + (list)])]))) (def: (random-if random-value output?) (-> Scenario Scenario) @@ -258,23 +258,23 @@ [loop?-then expected-then actual-then] (random-value output?) [loop?-else expected-else actual-else] (random-value output?) flip? random.bit] - (wrap [(and loop?-test - loop?-then - loop?-else) - (synthesis.branch/if [expected-test - expected-then - expected-else]) - (if flip? - (#analysis.Case actual-test - [{#analysis.when (analysis.pattern/bit false) - #analysis.then actual-else} - (list {#analysis.when (analysis.pattern/bit true) - #analysis.then actual-then})]) - (#analysis.Case actual-test - [{#analysis.when (analysis.pattern/bit true) - #analysis.then actual-then} - (list {#analysis.when (analysis.pattern/bit false) - #analysis.then actual-else})]))]))) + (in [(and loop?-test + loop?-then + loop?-else) + (synthesis.branch/if [expected-test + expected-then + expected-else]) + (if flip? + (#analysis.Case actual-test + [{#analysis.when (analysis.pattern/bit false) + #analysis.then actual-else} + (list {#analysis.when (analysis.pattern/bit true) + #analysis.then actual-then})]) + (#analysis.Case actual-test + [{#analysis.when (analysis.pattern/bit true) + #analysis.then actual-then} + (list {#analysis.when (analysis.pattern/bit false) + #analysis.then actual-else})]))]))) (def: (random-get random-value output?) (-> Scenario Scenario) @@ -282,19 +282,19 @@ [lefts (|> random.nat (\ ! map (n.% 10))) right? random.bit [loop?-record expected-record actual-record] (random-value false)] - (wrap [loop?-record - (synthesis.branch/get [(list (if right? - (#.Right lefts) - (#.Left lefts))) - expected-record]) - (#analysis.Case actual-record - [{#analysis.when (analysis.pattern/tuple - (list\compose (list.repeat lefts (analysis.pattern/unit)) - (if right? - (list (analysis.pattern/unit) (#analysis.Bind 2)) - (list (#analysis.Bind 2) (analysis.pattern/unit))))) - #analysis.then (#analysis.Reference (reference.local 2))} - (list)])]))) + (in [loop?-record + (synthesis.branch/get [(list (if right? + (#.Right lefts) + (#.Left lefts))) + expected-record]) + (#analysis.Case actual-record + [{#analysis.when (analysis.pattern/tuple + (list\compose (list.repeat lefts (analysis.pattern/unit)) + (if right? + (list (analysis.pattern/unit) (#analysis.Bind 2)) + (list (#analysis.Bind 2) (analysis.pattern/unit))))) + #analysis.then (#analysis.Reference (reference.local 2))} + (list)])]))) (def: (random-branch arity random-value output?) (-> Arity Scenario Scenario) @@ -307,28 +307,28 @@ (-> Arity Scenario Scenario) (do {! random.monad} [resets (random.list arity (random-value false))] - (wrap [true - (synthesis.loop/recur (list\map (|>> product.right product.left) resets)) - (analysis.apply [(#analysis.Reference (case arity - 1 (reference.local 0) - _ (reference.foreign 0))) - (list\map (|>> product.right product.right) resets)])]))) + (in [true + (synthesis.loop/recur (list\map (|>> product.right product.left) resets)) + (analysis.apply [(#analysis.Reference (case arity + 1 (reference.local 0) + _ (reference.foreign 0))) + (list\map (|>> product.right product.right) resets)])]))) (def: (random-scope arity output?) (-> Arity Scenario) (do {! random.monad} [resets (random.list arity (..random-variable arity output?)) [_ expected-output actual-output] (..random-nat output?)] - (wrap [(list\fold (function (_ new old) - (and new old)) - true - (list\map product.left resets)) - (synthesis.loop/scope - {#synthesis.start (inc arity) - #synthesis.inits (list\map (|>> product.right product.left) resets) - #synthesis.iteration expected-output}) - (analysis.apply [(..n-abstraction arity actual-output) - (list\map (|>> product.right product.right) resets)])]))) + (in [(list\fold (function (_ new old) + (and new old)) + true + (list\map product.left resets)) + (synthesis.loop/scope + {#synthesis.start (inc arity) + #synthesis.inits (list\map (|>> product.right product.left) resets) + #synthesis.iteration expected-output}) + (analysis.apply [(..n-abstraction arity actual-output) + (list\map (|>> product.right product.right) resets)])]))) (def: (random-loop arity random-value output?) (-> Arity Scenario Scenario) @@ -348,16 +348,16 @@ (list\map (|>> #variable.Foreign) (list.indices arity)) (list (#variable.Local 1)))]] - (wrap [true - (synthesis.function/abstraction - {#synthesis.environment environment - #synthesis.arity 1 - #synthesis.body (synthesis.loop/scope - {#synthesis.start 1 - #synthesis.inits (list) - #synthesis.iteration expected-output})}) - (#analysis.Function environment - actual-output)]))) + (in [true + (synthesis.function/abstraction + {#synthesis.environment environment + #synthesis.arity 1 + #synthesis.body (synthesis.loop/scope + {#synthesis.start 1 + #synthesis.inits (list) + #synthesis.iteration expected-output})}) + (#analysis.Function environment + actual-output)]))) (def: (random-apply random-value output?) (-> Scenario Scenario) @@ -365,14 +365,14 @@ [[loop?-abstraction expected-abstraction actual-abstraction] (..random-nat output?) arity (|> random.nat (\ ! map (|>> (n.% 5) inc))) inputs (random.list arity (random-value false))] - (wrap [(list\fold (function (_ new old) - (and new old)) - loop?-abstraction - (list\map product.left inputs)) - (synthesis.function/apply [expected-abstraction - (list\map (|>> product.right product.left) inputs)]) - (analysis.apply [actual-abstraction - (list\map (|>> product.right product.right) inputs)])]))) + (in [(list\fold (function (_ new old) + (and new old)) + loop?-abstraction + (list\map product.left inputs)) + (synthesis.function/apply [expected-abstraction + (list\map (|>> product.right product.left) inputs)]) + (analysis.apply [actual-abstraction + (list\map (|>> product.right product.right) inputs)])]))) (def: (random-function random-value output?) (-> Scenario Scenario) @@ -398,11 +398,11 @@ [loop?-first expected-first actual-first] (random-value false) [loop?-second expected-second actual-second] (random-value false) [loop?-third expected-third actual-third] (random-value false)] - (wrap [(and loop?-first - loop?-second - loop?-third) - (#synthesis.Extension name (list expected-first expected-second expected-third)) - (#analysis.Extension name (list actual-first actual-second actual-third))]))) + (in [(and loop?-first + loop?-second + loop?-third) + (#synthesis.Extension name (list expected-first expected-second expected-third)) + (#analysis.Extension name (list actual-first actual-second actual-third))]))) (def: (random-body arity) (-> Arity Scenario) @@ -421,8 +421,8 @@ (do {! random.monad} [arity (|> random.nat (\ ! map (|>> (n.% 5) inc))) [loop? expected-body actual-body] (random-body arity true)] - (wrap [(..n-function loop? arity expected-body) - (..n-abstraction arity actual-body)]))) + (in [(..n-function loop? arity expected-body) + (..n-abstraction arity actual-body)]))) (def: abstraction Test diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/loop.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/loop.lux index 7e1ebf587..3598bbf7c 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/loop.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/loop.lux @@ -32,9 +32,9 @@ (~~ (template [<synthesis> <random>] [(do {! random.monad} [example (\ ! map (|>> <synthesis>) <random>)] - (wrap [next - [example - example]]))] + (in [next + [example + example]]))] [//.bit random.bit] [//.i64 (\ ! map .i64 random.nat)] @@ -48,26 +48,26 @@ (do random.monad [name (random.and (random.unicode 1) (random.unicode 1))] - (wrap [next - [name - name]]))) + (in [next + [name + name]]))) (def: (variable offset arity next) (Scenario Variable) (let [local (do {! random.monad} [register (\ ! map (|>> (n.% arity) inc) random.nat)] - (wrap [next - [(#variable.Local (/.register_optimization offset register)) - (#variable.Local register)]]))] + (in [next + [(#variable.Local (/.register_optimization offset register)) + (#variable.Local register)]]))] (case offset 0 local _ ($_ random.either local (do {! random.monad} [foreign (\ ! map (n.% offset) random.nat)] - (wrap [next - [(#variable.Local foreign) - (#variable.Foreign foreign)]])))))) + (in [next + [(#variable.Local foreign) + (#variable.Foreign foreign)]])))))) (def: (reference offset arity next) (Scenario Synthesis) @@ -75,9 +75,9 @@ (~~ (template [<tag> <random>] [(do {! random.monad} [[next [exampleE exampleA]] (<random> offset arity next)] - (wrap [next - [(<tag> exampleE) - (<tag> exampleA)]]))] + (in [next + [(<tag> exampleE) + (<tag> exampleA)]]))] [//.constant ..constant] [//.variable ..variable] @@ -90,21 +90,21 @@ [lefts random.nat right? random.bit [next [valueE valueA]] (..reference offset arity next)] - (wrap [next - [(//.variant - {#analysis.lefts lefts - #analysis.right? right? - #analysis.value valueE}) - (//.variant - {#analysis.lefts lefts - #analysis.right? right? - #analysis.value valueA})]])) + (in [next + [(//.variant + {#analysis.lefts lefts + #analysis.right? right? + #analysis.value valueE}) + (//.variant + {#analysis.lefts lefts + #analysis.right? right? + #analysis.value valueA})]])) (do {! random.monad} [[next [leftE leftA]] (..reference offset arity next) [next [rightE rightA]] (..reference offset arity next)] - (wrap [next - [(//.tuple (list leftE rightE)) - (//.tuple (list leftA rightA))]])) + (in [next + [(//.tuple (list leftE rightE)) + (//.tuple (list leftA rightA))]])) )) (def: path @@ -112,15 +112,15 @@ (let [pattern (: (Scenario Path) (.function (recur offset arity next) (`` ($_ random.either - (random\wrap [next - [//.path/pop - //.path/pop]]) + (random\in [next + [//.path/pop + //.path/pop]]) (~~ (template [<path> <random>] [(do {! random.monad} [example (\ ! map (|>> <path>) <random>)] - (wrap [next - [example - example]]))] + (in [next + [example + example]]))] [//.path/bit random.bit] [//.path/i64 (\ ! map .i64 random.nat)] @@ -132,32 +132,32 @@ [example (\ ! map (|>> <path>) (random.or random.nat random.nat))] - (wrap [next - [example - example]]))] + (in [next + [example + example]]))] [//.path/side] [//.path/member] )) - (random\wrap [(inc next) - [(//.path/bind (/.register_optimization offset next)) - (//.path/bind next)]]) + (random\in [(inc next) + [(//.path/bind (/.register_optimization offset next)) + (//.path/bind next)]]) )))) sequential (: (Scenario Path) (.function (recur offset arity next) (do random.monad [[next [patternE patternA]] (pattern offset arity next) [next [bodyE bodyA]] (..reference offset arity next)] - (wrap [next - [(//.path/seq patternE (//.path/then bodyE)) - (//.path/seq patternA (//.path/then bodyA))]]))))] + (in [next + [(//.path/seq patternE (//.path/then bodyE)) + (//.path/seq patternA (//.path/then bodyA))]]))))] (.function (recur offset arity next) (do random.monad [[next [leftE leftA]] (sequential offset arity next) [next [rightE rightA]] (sequential offset arity next)] - (wrap [next - [(//.path/alt leftE rightE) - (//.path/alt leftA rightA)]]))))) + (in [next + [(//.path/alt leftE rightE) + (//.path/alt leftA rightA)]]))))) (def: (branch offset arity next) (Scenario Synthesis) @@ -169,30 +169,30 @@ (do {! random.monad} [[next [inputE inputA]] (..reference offset arity next) [next [bodyE bodyA]] (..reference offset arity next)] - (wrap [next - [(//.branch/let [inputE (/.register_optimization offset next) bodyE]) - (//.branch/let [inputA next bodyA])]])) + (in [next + [(//.branch/let [inputE (/.register_optimization offset next) bodyE]) + (//.branch/let [inputA next bodyA])]])) (do {! random.monad} [[next [testE testA]] (..reference offset arity next) [next [thenE thenA]] (..reference offset arity next) [next [elseE elseA]] (..reference offset arity next)] - (wrap [next - [(//.branch/if [testE thenE elseE]) - (//.branch/if [testA thenA elseA])]]))) + (in [next + [(//.branch/if [testE thenE elseE]) + (//.branch/if [testA thenA elseA])]]))) ($_ random.either (do {! random.monad} [[next [recordE recordA]] (..reference offset arity next) path_length (\ ! map (|>> (n.% 5) inc) random.nat) path (random.list path_length random_member)] - (wrap [next - [(//.branch/get [path recordE]) - (//.branch/get [path recordA])]])) + (in [next + [(//.branch/get [path recordE]) + (//.branch/get [path recordA])]])) (do {! random.monad} [[next [inputE inputA]] (..reference offset arity next) [next [pathE pathA]] (..path offset arity next)] - (wrap [next - [(//.branch/case [inputE pathE]) - (//.branch/case [inputA pathA])]]))) + (in [next + [(//.branch/case [inputE pathE]) + (//.branch/case [inputA pathA])]]))) ))) (def: (loop offset arity next) @@ -202,15 +202,15 @@ [[next [firstE firstA]] (..reference offset arity next) [next [secondE secondA]] (..reference offset arity next) [next [iterationE iterationA]] (..reference offset arity next)] - (wrap [next - [(//.loop/scope - {#//.start (/.register_optimization offset next) - #//.inits (list firstE secondE) - #//.iteration iterationE}) - (//.loop/scope - {#//.start next - #//.inits (list firstA secondA) - #//.iteration iterationA})]])) + (in [next + [(//.loop/scope + {#//.start (/.register_optimization offset next) + #//.inits (list firstE secondE) + #//.iteration iterationE}) + (//.loop/scope + {#//.start next + #//.inits (list firstA secondA) + #//.iteration iterationA})]])) )) (def: (function offset arity next) @@ -221,15 +221,15 @@ [next [secondE secondA]] (..variable offset arity next) arity (\ ! map (n.max 1) random.nat) [next [bodyE bodyA]] (..primitive 0 arity next)] - (wrap [next - [(//.function/abstraction - {#//.environment (list firstE secondE) - #//.arity arity - #//.body bodyE}) - (//.function/abstraction - {#//.environment (list firstA secondA) - #//.arity arity - #//.body bodyA})]])) + (in [next + [(//.function/abstraction + {#//.environment (list firstE secondE) + #//.arity arity + #//.body bodyE}) + (//.function/abstraction + {#//.environment (list firstA secondA) + #//.arity arity + #//.body bodyA})]])) )) (def: (control offset arity next) @@ -247,9 +247,9 @@ [next [firstE firstA]] (..reference offset arity next) [next [secondE secondA]] (..reference offset arity next) [next [thirdE thirdA]] (..reference offset arity next)] - (wrap [next - [(#//.Extension name (list firstE secondE thirdE)) - (#//.Extension name (list firstA secondA thirdA))]]))) + (in [next + [(#//.Extension name (list firstE secondE thirdE)) + (#//.Extension name (list firstA secondA thirdA))]]))) (def: (scenario offset arity next) (Scenario Synthesis) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/primitive.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/primitive.lux index 7908da928..e46960793 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/primitive.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/primitive.lux @@ -32,14 +32,14 @@ (do r.monad [primitive (: (Random ////analysis.Primitive) ($_ r.or - (wrap []) + (in []) r.bit r.nat r.int r.rev r.frac (r.unicode 5)))] - (wrap (#////analysis.Primitive primitive)))) + (in (#////analysis.Primitive primitive)))) (def: #export (corresponds? analysis synthesis) (-> Analysis Synthesis Bit) @@ -87,7 +87,7 @@ _ false))))] - [#////analysis.Unit #////synthesis.Text (r\wrap ////synthesis.unit)] + [#////analysis.Unit #////synthesis.Text (r\in ////synthesis.unit)] [#////analysis.Bit #////synthesis.Bit r.bit] [#////analysis.Nat #////synthesis.I64 (r\map .i64 r.nat)] [#////analysis.Int #////synthesis.I64 (r\map .i64 r.int)] diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/variable.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/variable.lux index f50a196b6..8fa9ad158 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/variable.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/variable.lux @@ -46,8 +46,8 @@ (Scenario Synthesis) (do {! random.monad} [value <random>] - (wrap [(<synthesis> value) - (<synthesis> value)])))] + (in [(<synthesis> value) + (<synthesis> value)])))] [bit-scenario synthesis.bit random.bit] [i64-scenario synthesis.i64 (\ ! map .i64 random.nat)] @@ -73,15 +73,15 @@ #let [fake-register (n.+ (get@ #redundants context) (dictionary.size (get@ #necessary context)))] [expected-output actual-output] (scenario (update@ #redundants inc context))] - (wrap [(synthesis.branch/case [expected-input - (#synthesis.Seq #synthesis.Pop - (#synthesis.Then expected-output))]) - (if let? - (synthesis.branch/let [actual-input fake-register actual-output]) - (synthesis.branch/case [actual-input - (#synthesis.Seq (#synthesis.Bind fake-register) - (#synthesis.Seq #synthesis.Pop - (#synthesis.Then actual-output)))]))])) + (in [(synthesis.branch/case [expected-input + (#synthesis.Seq #synthesis.Pop + (#synthesis.Then expected-output))]) + (if let? + (synthesis.branch/let [actual-input fake-register actual-output]) + (synthesis.branch/case [actual-input + (#synthesis.Seq (#synthesis.Bind fake-register) + (#synthesis.Seq #synthesis.Pop + (#synthesis.Then actual-output)))]))])) (scenario context)))) (def: (variant-scenario scenario context) @@ -90,13 +90,13 @@ [lefts random.nat right? random.bit [expected input] (scenario context)] - (wrap [(synthesis.variant [lefts right? expected]) - (synthesis.variant [lefts right? input])]))) + (in [(synthesis.variant [lefts right? expected]) + (synthesis.variant [lefts right? input])]))) (def: (tuple-scenario context) (Scenario Synthesis) (let [registers (dictionary.entries (get@ #necessary context))] - (\ random.monad wrap + (\ random.monad in [(synthesis.tuple (list\map (|>> product.left synthesis.variable/local) registers)) (synthesis.tuple (list\map (|>> product.right synthesis.variable/local) registers))]))) @@ -108,37 +108,37 @@ (def: (let-scenario scenario context) (-> (Scenario Synthesis) (Scenario Synthesis)) (do random.monad - [_ (wrap []) + [_ (in []) [expected-input actual-input] (scenario context) #let [real-register (dictionary.size (get@ #necessary context)) fake-register (n.+ (get@ #redundants context) (dictionary.size (get@ #necessary context)))] [expected-output actual-output] (scenario (update@ #necessary (dictionary.put real-register fake-register) context))] - (wrap [(synthesis.branch/let [expected-input real-register expected-output]) - (synthesis.branch/let [actual-input fake-register actual-output])]))) + (in [(synthesis.branch/let [expected-input real-register expected-output]) + (synthesis.branch/let [actual-input fake-register actual-output])]))) (def: (if-scenario scenario context) (-> (Scenario Synthesis) (Scenario Synthesis)) (do random.monad - [_ (wrap []) + [_ (in []) [expected-test actual-test] (scenario context) [expected-then actual-then] (scenario context) [expected-else actual-else] (scenario context)] - (wrap [(synthesis.branch/if [expected-test - expected-then - expected-else]) - (synthesis.branch/if [actual-test - actual-then - actual-else])]))) + (in [(synthesis.branch/if [expected-test + expected-then + expected-else]) + (synthesis.branch/if [actual-test + actual-then + actual-else])]))) (def: random-member (Random Member) (do random.monad [lefts random.nat right? random.bit] - (wrap (if right? - (#.Right lefts) - (#.Left lefts))))) + (in (if right? + (#.Right lefts) + (#.Left lefts))))) (def: (get-scenario scenario context) (-> (Scenario Synthesis) (Scenario Synthesis)) @@ -146,8 +146,8 @@ [length (\ ! map (|>> (n.% 5) inc) random.nat) path (random.list length ..random-member) [expected-record actual-record] (scenario context)] - (wrap [(synthesis.branch/get [path expected-record]) - (synthesis.branch/get [path actual-record])]))) + (in [(synthesis.branch/get [path expected-record]) + (synthesis.branch/get [path actual-record])]))) (def: random-side (Random Side) @@ -158,33 +158,33 @@ (`` ($_ random.either ($_ random.either (do {! random.monad} - [_ (wrap []) + [_ (in []) [expected-then actual-then] (scenario context)] - (wrap [(#synthesis.Seq #synthesis.Pop - (#synthesis.Then expected-then)) - (#synthesis.Seq #synthesis.Pop - (#synthesis.Then actual-then))])) + (in [(#synthesis.Seq #synthesis.Pop + (#synthesis.Then expected-then)) + (#synthesis.Seq #synthesis.Pop + (#synthesis.Then actual-then))])) (do {! random.monad} - [_ (wrap []) + [_ (in []) #let [real-register (dictionary.size (get@ #necessary context)) fake-register (n.+ (get@ #redundants context) (dictionary.size (get@ #necessary context)))] [expected-then actual-then] (scenario (update@ #necessary (dictionary.put real-register fake-register) context))] - (wrap [(#synthesis.Seq (#synthesis.Bind real-register) - (#synthesis.Seq #synthesis.Pop - (#synthesis.Then expected-then))) - (#synthesis.Seq (#synthesis.Bind fake-register) - (#synthesis.Seq #synthesis.Pop - (#synthesis.Then actual-then)))]))) + (in [(#synthesis.Seq (#synthesis.Bind real-register) + (#synthesis.Seq #synthesis.Pop + (#synthesis.Then expected-then))) + (#synthesis.Seq (#synthesis.Bind fake-register) + (#synthesis.Seq #synthesis.Pop + (#synthesis.Then actual-then)))]))) ($_ random.either (~~ (template [<tag> <random>] [(do {! random.monad} [test <random> [expected-then actual-then] (scenario context)] - (wrap [(#synthesis.Seq (#synthesis.Test (<tag> test)) - (#synthesis.Then expected-then)) - (#synthesis.Seq (#synthesis.Test (<tag> test)) - (#synthesis.Then actual-then))]))] + (in [(#synthesis.Seq (#synthesis.Test (<tag> test)) + (#synthesis.Then expected-then)) + (#synthesis.Seq (#synthesis.Test (<tag> test)) + (#synthesis.Then actual-then))]))] [#synthesis.Bit random.bit] [#synthesis.I64 (\ ! map .i64 random.nat)] @@ -195,33 +195,33 @@ (do {! random.monad} [side ..random-side [expected-next actual-next] (path-scenario scenario context)] - (wrap [(#synthesis.Seq (#synthesis.Access (#synthesis.Side side)) - expected-next) - (#synthesis.Seq (#synthesis.Access (#synthesis.Side side)) - actual-next)])) + (in [(#synthesis.Seq (#synthesis.Access (#synthesis.Side side)) + expected-next) + (#synthesis.Seq (#synthesis.Access (#synthesis.Side side)) + actual-next)])) (do {! random.monad} [member ..random-member [expected-next actual-next] (path-scenario scenario context)] - (wrap [(#synthesis.Seq (#synthesis.Access (#synthesis.Member member)) - expected-next) - (#synthesis.Seq (#synthesis.Access (#synthesis.Member member)) - actual-next)]))) + (in [(#synthesis.Seq (#synthesis.Access (#synthesis.Member member)) + expected-next) + (#synthesis.Seq (#synthesis.Access (#synthesis.Member member)) + actual-next)]))) (do {! random.monad} - [_ (wrap []) + [_ (in []) [expected-left actual-left] (path-scenario scenario context) [expected-right actual-right] (path-scenario scenario context)] - (wrap [(#synthesis.Alt expected-left expected-right) - (#synthesis.Alt actual-left actual-right)])) + (in [(#synthesis.Alt expected-left expected-right) + (#synthesis.Alt actual-left actual-right)])) ))) (def: (case-scenario scenario context) (-> (Scenario Synthesis) (Scenario Synthesis)) (do {! random.monad} - [_ (wrap []) + [_ (in []) [expected-input actual-input] (scenario context) [expected-path actual-path] (..path-scenario scenario context)] - (wrap [(synthesis.branch/case [expected-input expected-path]) - (synthesis.branch/case [actual-input actual-path])]))) + (in [(synthesis.branch/case [expected-input expected-path]) + (synthesis.branch/case [actual-input actual-path])]))) (def: (branch-scenario scenario context) (-> (Scenario Synthesis) (Scenario Synthesis)) @@ -237,7 +237,7 @@ (def: (scope-scenario scenario context) (-> (Scenario Synthesis) (Scenario Synthesis)) (do {! random.monad} - [_ (wrap []) + [_ (in []) #let [real-start (dictionary.size (get@ #necessary context)) fake-start (n.+ (get@ #redundants context) real-start)] @@ -251,16 +251,16 @@ necessary (list.enumeration inits))) context))] - (wrap [(synthesis.loop/scope [real-start (list\map product.left inits) expected-iteration]) - (synthesis.loop/scope [fake-start (list\map product.right inits) actual-iteration])]))) + (in [(synthesis.loop/scope [real-start (list\map product.left inits) expected-iteration]) + (synthesis.loop/scope [fake-start (list\map product.right inits) actual-iteration])]))) (def: (recur-scenario scenario context) (-> (Scenario Synthesis) (Scenario Synthesis)) (do {! random.monad} - [_ (wrap []) + [_ (in []) resets (random.list ..scope-arity (scenario context))] - (wrap [(synthesis.loop/recur (list\map product.left resets)) - (synthesis.loop/recur (list\map product.right resets))]))) + (in [(synthesis.loop/recur (list\map product.left resets)) + (synthesis.loop/recur (list\map product.right resets))]))) (def: (loop-scenario scenario context) (-> (Scenario Synthesis) (Scenario Synthesis)) @@ -272,13 +272,13 @@ (def: (abstraction-scenario scenario context) (-> (Scenario Synthesis) (Scenario Synthesis)) (do {! random.monad} - [_ (wrap []) + [_ (in []) #let [registers (dictionary.entries (get@ #necessary context)) expected-environment (list\map (|>> product.left #variable.Local) registers) actual-environment (list\map (|>> product.right #variable.Local) registers)] [expected-body actual-body] (..primitive-scenario context)] - (wrap [(synthesis.function/abstraction [expected-environment 1 expected-body]) - (synthesis.function/abstraction [actual-environment 1 actual-body])]))) + (in [(synthesis.function/abstraction [expected-environment 1 expected-body]) + (synthesis.function/abstraction [actual-environment 1 actual-body])]))) (def: (apply-scenario scenario context) (-> (Scenario Synthesis) (Scenario Synthesis)) @@ -287,8 +287,8 @@ (random.and (random.unicode 1) (random.unicode 1))) inputs (random.list ..scope-arity (scenario context))] - (wrap [(synthesis.function/apply [abstraction (list\map product.left inputs)]) - (synthesis.function/apply [abstraction (list\map product.right inputs)])]))) + (in [(synthesis.function/apply [abstraction (list\map product.left inputs)]) + (synthesis.function/apply [abstraction (list\map product.right inputs)])]))) (def: (function-scenario scenario context) (-> (Scenario Synthesis) (Scenario Synthesis)) @@ -311,9 +311,9 @@ (..primitive-scenario context) (..structure-scenario context) (..control-scenario (..with-redundancy - (..control-scenario - (..with-redundancy - ..structure-scenario))) + (..control-scenario + (..with-redundancy + ..structure-scenario))) context) )) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/syntax.lux b/stdlib/source/test/lux/tool/compiler/language/lux/syntax.lux index 8a71ed224..4e4968462 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/syntax.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/syntax.lux @@ -117,7 +117,7 @@ (Random Text) (do r.monad [comment comment-text^] - (wrap (format "## " comment text.new-line)))) + (in (format "## " comment text.new-line)))) (def: comments Test diff --git a/stdlib/source/test/lux/type.lux b/stdlib/source/test/lux/type.lux index 65c02256b..521ca4851 100644 --- a/stdlib/source/test/lux/type.lux +++ b/stdlib/source/test/lux/type.lux @@ -47,9 +47,9 @@ (function (_ recur) (let [pairG (random.and recur recur) idG random.nat - quantifiedG (random.and (random\wrap (list)) recur)] + quantifiedG (random.and (random\in (list)) recur)] ($_ random.or - (random.and ..short (random\wrap (list))) + (random.and ..short (random\in (list))) pairG pairG pairG @@ -113,7 +113,7 @@ (do maybe.monad [partial (/.applied (list Bit) Ann) full (/.applied (list Int) partial)] - (wrap (\ /.equivalence = full (#.Product Bit Int))))) + (in (\ /.equivalence = full (#.Product Bit Int))))) (|> (/.applied (list Bit) Text) (case> #.None #1 _ #0)))) (do {! random.monad} diff --git a/stdlib/source/test/lux/type/abstract.lux b/stdlib/source/test/lux/type/abstract.lux index 47d478f3f..aaeb6f1b6 100644 --- a/stdlib/source/test/lux/type/abstract.lux +++ b/stdlib/source/test/lux/type/abstract.lux @@ -26,7 +26,7 @@ [(syntax: (<syntax>) (do meta.monad [frame <meta>] - (wrap (list (code.text (get@ #/.name frame))))))] + (in (list (code.text (get@ #/.name frame))))))] [current /.current] [specific (/.specific (template.text [g!Foo]))] diff --git a/stdlib/source/test/lux/type/check.lux b/stdlib/source/test/lux/type/check.lux index 8ced5e3eb..982234fb1 100644 --- a/stdlib/source/test/lux/type/check.lux +++ b/stdlib/source/test/lux/type/check.lux @@ -44,7 +44,7 @@ (random.rec (function (_ recur) (let [pairG (random.and recur recur) - quantifiedG (random.and (random\wrap (list)) (type' (inc num_vars))) + quantifiedG (random.and (random\in (list)) (type' (inc num_vars))) random_pair (random.either (random.either (random\map (|>> #.Sum) pairG) (random\map (|>> #.Product) pairG)) (random.either (random\map (|>> #.Function) pairG) @@ -58,7 +58,7 @@ random_quantified (random.either (random\map (|>> #.UnivQ) quantifiedG) (random\map (|>> #.ExQ) quantifiedG))] ($_ random.either - (random\map (|>> #.Primitive) (random.and ..short (random\wrap (list)))) + (random\map (|>> #.Primitive) (random.and ..short (random\in (list)))) random_pair random_id random_quantified @@ -91,7 +91,7 @@ (def: injection (Injection (All [a] (/.Check a))) - (\ /.monad wrap)) + (\ /.monad in)) (def: comparison (Comparison (All [a] (/.Check a))) @@ -138,10 +138,10 @@ (case (/.run /.fresh_context (/.assert expected false)) (#try.Success _) false (#try.Failure actual) (is? expected actual))))) - (_.cover [/.throw] + (_.cover [/.except] (case (/.run /.fresh_context (: (/.Check Any) - (/.throw ..yolo []))) + (/.except ..yolo []))) (#try.Success _) false (#try.Failure error) (exception.match? ..yolo error))) )) @@ -154,7 +154,7 @@ (case (/.run /.fresh_context (do /.monad [[var_id var_type] /.var] - (wrap (type\= var_type (#.Var var_id))))) + (in (type\= var_type (#.Var var_id))))) (#try.Success verdict) verdict (#try.Failure error) false)) (do random.monad @@ -165,7 +165,7 @@ [[var_id var_type] /.var _ (/.bind (#.Primitive nominal (list)) var_id)] - (wrap true))) + (in true))) (#try.Success _) true (#try.Failure error) false))) (do random.monad @@ -177,8 +177,8 @@ _ (/.bind (#.Primitive nominal (list)) var_id) post (/.bound? var_id)] - (wrap (and (not pre) - post))) + (in (and (not pre) + post))) (/.run /.fresh_context) (try.default false)) (|> (do /.monad @@ -187,8 +187,8 @@ [_ var/1] /.var _ (/.check var/0 var/1) post (/.bound? var_id)] - (wrap (and (not pre) - (not post)))) + (in (and (not pre) + (not post)))) (/.run /.fresh_context) (try.default false))))) (do random.monad @@ -332,14 +332,14 @@ (Random Type) (do random.monad [name (random.ascii/upper 10)] - (wrap (#.Primitive name (list))))) + (in (#.Primitive name (list))))) (def: (non_twins = random) (All [a] (-> (-> a a Bit) (Random a) (Random [a a]))) (do random.monad [left random right (random.only (|>> (= left) not) random)] - (wrap [left right]))) + (in [left right]))) (type: Super (Ex [sub] [Text sub])) @@ -420,16 +420,16 @@ var/tail+ (monad.map ! (function (_ _) (do ! [[id/T var/tail] /.var] - (wrap var/tail))) + (in var/tail))) (list.repeat tail_size /.var)) var/last (monad.fold ! (function (_ var/next var/prev) (do ! [_ (/.check var/prev var/next)] - (wrap var/next))) + (in var/next))) var/head var/tail+) _ (/.check var/last var/head)] - (wrap [var/head var/tail+ var/last]))) + (in [var/head var/tail+ var/last]))) (def: (handles_var_rings! tail_size nominal/0 nominal/1) (-> Nat Type Type Bit) @@ -644,14 +644,14 @@ [module (random.ascii/upper 10) short (random.ascii/upper 10) anonymousT dirty_type] - (wrap (function (_ holeT) - (#.Named [module short] (anonymousT holeT))))) + (in (function (_ holeT) + (#.Named [module short] (anonymousT holeT))))) (~~ (template [<tag>] [(do random.monad [leftT dirty_type rightT dirty_type] - (wrap (function (_ holeT) - (<tag> (leftT holeT) (rightT holeT)))))] + (in (function (_ holeT) + (<tag> (leftT holeT) (rightT holeT)))))] [#.Sum] [#.Product] @@ -661,16 +661,16 @@ (do {! random.monad} [name (random.ascii/upper 10) parameterT dirty_type] - (wrap (function (_ holeT) - (#.Primitive name (list (parameterT holeT)))))) + (in (function (_ holeT) + (#.Primitive name (list (parameterT holeT)))))) (~~ (template [<tag>] [(do {! random.monad} [funcT dirty_type argT dirty_type body random.nat] - (wrap (function (_ holeT) - (<tag> (list (funcT holeT) (argT holeT)) - (#.Parameter body)))))] + (in (function (_ holeT) + (<tag> (list (funcT holeT) (argT holeT)) + (#.Parameter body)))))] [#.UnivQ] [#.ExQ] @@ -685,8 +685,8 @@ (and (|> (do /.monad [[var_id varT] /.var cleanedT (/.clean (type_shape varT))] - (wrap (type\= (type_shape varT) - cleanedT))) + (in (type\= (type_shape varT) + cleanedT))) (/.run /.fresh_context) (try.default false)) (|> (do /.monad @@ -694,8 +694,8 @@ [_ replacementT] /.existential _ (/.check varT replacementT) cleanedT (/.clean (type_shape varT))] - (wrap (type\= (type_shape replacementT) - cleanedT))) + (in (type\= (type_shape replacementT) + cleanedT))) (/.run /.fresh_context) (try.default false)) )))) @@ -710,7 +710,7 @@ [expected random.nat] (_.cover [/.run] (case (/.run /.fresh_context - (\ /.monad wrap expected)) + (\ /.monad in expected)) (#try.Success actual) (is? expected actual) (#try.Failure error) false))) ..error_handling diff --git a/stdlib/source/test/lux/type/resource.lux b/stdlib/source/test/lux/type/resource.lux index 9e5da1d8a..cd6f78096 100644 --- a/stdlib/source/test/lux/type/resource.lux +++ b/stdlib/source/test/lux/type/resource.lux @@ -38,7 +38,7 @@ /.run_pure (do /.pure <bindings> - (wrap (format left right)))))] + (in (format left right)))))] [[/.Affine /.Key /.Res /.Ordered /.ordered_pure /.Relevant /.read_pure] @@ -79,7 +79,7 @@ /.run_sync (do /.sync <bindings> - (wrap (format left right)))))] + (in (format left right)))))] [[/.Affine /.Key /.Res /.Ordered /.ordered_sync /.Relevant /.read_sync] @@ -114,14 +114,14 @@ (_.for [/.Linear /.async /.run_async] (`` ($_ _.and (~~ (template [<coverage> <bindings>] - [(wrap (monad.do async.monad - [outcome (/.run_async - (do /.async - <bindings> - (wrap (format left right))))] - (_.cover' <coverage> - (text\= (format pre post) - outcome))))] + [(in (monad.do async.monad + [outcome (/.run_async + (do /.async + <bindings> + (in (format left right))))] + (_.cover' <coverage> + (text\= (format pre post) + outcome))))] [[/.Affine /.Key /.Res /.Ordered /.ordered_async /.Relevant /.read_async] @@ -150,7 +150,7 @@ (syntax: (with_error {exception <code>.identifier} to_expand) (monad.do meta.monad - [[_ _ _ exception] (meta.find_export exception)] + [[_ _ _ exception] (meta.export exception)] (function (_ compiler) (#.Right [compiler (list (code.bit (case ((macro.expand_once to_expand) compiler) diff --git a/stdlib/source/test/lux/world/console.lux b/stdlib/source/test/lux/world/console.lux index e7fd9f42b..c007b3ea8 100644 --- a/stdlib/source/test/lux/world/console.lux +++ b/stdlib/source/test/lux/world/console.lux @@ -28,24 +28,24 @@ [char (try.of_maybe (text.nth 0 content)) [_ content] (try.of_maybe (text.split 1 content))] (if dead? - (exception.throw ..dead []) - (wrap [[dead? content] char])))) + (exception.except ..dead []) + (in [[dead? content] char])))) (def: (on_read_line [dead? content]) (do try.monad [[line content] (try.of_maybe (text.split_with text.new_line content))] (if dead? - (exception.throw ..dead []) - (wrap [[dead? content] line])))) + (exception.except ..dead []) + (in [[dead? content] line])))) (def: (on_write message [dead? content]) (if dead? - (exception.throw ..dead []) + (exception.except ..dead []) (#try.Success [dead? (format content message)]))) (def: (on_close [dead? content]) (if dead? - (exception.throw ..dead []) + (exception.except ..dead []) (#try.Success [true content]))))) (def: #export test @@ -62,9 +62,9 @@ (do io.monad [?_ (/.write_line expected console) ?actual (\ console read_line [])] - (wrap (<| (try.default false) - (do try.monad - [_ ?_ - actual ?actual] - (wrap (text\= expected actual))))))))) + (in (<| (try.default false) + (do try.monad + [_ ?_ + actual ?actual] + (in (text\= expected actual))))))))) ))) diff --git a/stdlib/source/test/lux/world/file/watch.lux b/stdlib/source/test/lux/world/file/watch.lux index cb24e89b7..7d09023cf 100644 --- a/stdlib/source/test/lux/world/file/watch.lux +++ b/stdlib/source/test/lux/world/file/watch.lux @@ -28,9 +28,9 @@ (def: concern (Random [/.Concern (Predicate /.Concern)]) ($_ random.either - (random\wrap [/.creation /.creation?]) - (random\wrap [/.modification /.modification?]) - (random\wrap [/.deletion /.deletion?]) + (random\in [/.creation /.creation?]) + (random\in [/.modification /.modification?]) + (random\in [/.deletion /.deletion?]) )) (def: concern\\test @@ -71,22 +71,22 @@ [directory (random.ascii/alpha 5) #let [[fs watcher] (/.mock "/")]] ($_ _.and - (wrap (do async.monad - [?concern (\ watcher concern directory) - ?stop (\ watcher stop directory)] - (_.cover' [/.not_being_watched] - (and (case ?concern - (#try.Failure error) - (exception.match? /.not_being_watched error) - - (#try.Success _) - false) - (case ?stop - (#try.Failure error) - (exception.match? /.not_being_watched error) - - (#try.Success _) - false))))) + (in (do async.monad + [?concern (\ watcher concern directory) + ?stop (\ watcher stop directory)] + (_.cover' [/.not_being_watched] + (and (case ?concern + (#try.Failure error) + (exception.match? /.not_being_watched error) + + (#try.Success _) + false) + (case ?stop + (#try.Failure error) + (exception.match? /.not_being_watched error) + + (#try.Success _) + false))))) ))) (def: (no_events_prior_to_creation! fs watcher directory) @@ -104,16 +104,16 @@ (//.make_file async.monad fs (binary.create 0) expected_path)) poll/pre (\ watcher poll []) poll/post (\ watcher poll [])] - (wrap (and (case poll/pre - (^ (list [concern actual_path])) - (and (text\= expected_path actual_path) - (and (/.creation? concern) - (not (/.modification? concern)) - (not (/.deletion? concern)))) + (in (and (case poll/pre + (^ (list [concern actual_path])) + (and (text\= expected_path actual_path) + (and (/.creation? concern) + (not (/.modification? concern)) + (not (/.deletion? concern)))) - _ - false) - (list.empty? poll/post))))) + _ + false) + (list.empty? poll/post))))) (def: (after_modification! fs watcher data expected_path) (-> (//.System Async) (/.Watcher Async) Binary //.Path (Async (Try Bit))) @@ -122,16 +122,16 @@ _ (\ fs write data expected_path) poll/2 (\ watcher poll []) poll/2' (\ watcher poll [])] - (wrap (and (case poll/2 - (^ (list [concern actual_path])) - (and (text\= expected_path actual_path) - (and (not (/.creation? concern)) - (/.modification? concern) - (not (/.deletion? concern)))) + (in (and (case poll/2 + (^ (list [concern actual_path])) + (and (text\= expected_path actual_path) + (and (not (/.creation? concern)) + (/.modification? concern) + (not (/.deletion? concern)))) - _ - false) - (list.empty? poll/2'))))) + _ + false) + (list.empty? poll/2'))))) (def: (after_deletion! fs watcher expected_path) (-> (//.System Async) (/.Watcher Async) //.Path (Async (Try Bit))) @@ -139,15 +139,15 @@ [_ (\ fs delete expected_path) poll/3 (\ watcher poll []) poll/3' (\ watcher poll [])] - (wrap (and (case poll/3 - (^ (list [concern actual_path])) - (and (not (/.creation? concern)) - (not (/.modification? concern)) - (/.deletion? concern)) + (in (and (case poll/3 + (^ (list [concern actual_path])) + (and (not (/.creation? concern)) + (not (/.modification? concern)) + (/.deletion? concern)) - _ - false) - (list.empty? poll/3'))))) + _ + false) + (list.empty? poll/3'))))) (def: #export test Test @@ -164,36 +164,36 @@ expected_path (\ ! map (|>> (format directory /)) (random.ascii/alpha 5)) data ($binary.random 10)] - (wrap (do {! async.monad} - [verdict (do (try.with !) - [no_events_prior_to_creation! - (..no_events_prior_to_creation! fs watcher directory) - - after_creation! - (..after_creation! fs watcher expected_path) - - after_modification! - (..after_modification! fs watcher data expected_path) - - after_deletion! - (..after_deletion! fs watcher expected_path)] - (wrap (and no_events_prior_to_creation! - after_creation! - after_modification! - after_deletion!)))] - (_.cover' [/.mock /.polling] - (try.default false verdict))))) + (in (do {! async.monad} + [verdict (do (try.with !) + [no_events_prior_to_creation! + (..no_events_prior_to_creation! fs watcher directory) + + after_creation! + (..after_creation! fs watcher expected_path) + + after_modification! + (..after_modification! fs watcher data expected_path) + + after_deletion! + (..after_deletion! fs watcher expected_path)] + (in (and no_events_prior_to_creation! + after_creation! + after_modification! + after_deletion!)))] + (_.cover' [/.mock /.polling] + (try.default false verdict))))) (do random.monad [directory (random.ascii/alpha 5) #let [/ "/" [fs watcher] (/.mock /)]] - (wrap (do async.monad - [started? ( \ watcher start /.all directory)] - (_.cover' [/.cannot_poll_a_non_existent_directory] - (case started? - (#try.Success _) - false - - (#try.Failure error) - (exception.match? /.cannot_poll_a_non_existent_directory error)))))) + (in (do async.monad + [started? ( \ watcher start /.all directory)] + (_.cover' [/.cannot_poll_a_non_existent_directory] + (case started? + (#try.Success _) + false + + (#try.Failure error) + (exception.match? /.cannot_poll_a_non_existent_directory error)))))) ))) diff --git a/stdlib/source/test/lux/world/input/keyboard.lux b/stdlib/source/test/lux/world/input/keyboard.lux index 89c559bb5..24b657f0d 100644 --- a/stdlib/source/test/lux/world/input/keyboard.lux +++ b/stdlib/source/test/lux/world/input/keyboard.lux @@ -140,7 +140,7 @@ (let [count (list.size ..listing)] (do {! random.monad} [choice (\ ! map (n.% count) random.nat)] - (wrap (maybe.assume (list.nth choice ..listing)))))) + (in (maybe.assume (list.nth choice ..listing)))))) (def: #export test Test diff --git a/stdlib/source/test/lux/world/net/http/client.lux b/stdlib/source/test/lux/world/net/http/client.lux index c784d9cbe..1979003f0 100644 --- a/stdlib/source/test/lux/world/net/http/client.lux +++ b/stdlib/source/test/lux/world/net/http/client.lux @@ -73,7 +73,7 @@ [product.right (get@ #//.body) (function.apply #.None) io.run] [product.right (\ utf8.codec decode)] [(\ nat.decimal decode)] - [(nat.= <expected>) wrap]) + [(nat.= <expected>) in]) (try.default false)))] [/.post on_post] diff --git a/stdlib/source/test/lux/world/output/video/resolution.lux b/stdlib/source/test/lux/world/output/video/resolution.lux index 851214fb8..411ae288d 100644 --- a/stdlib/source/test/lux/world/output/video/resolution.lux +++ b/stdlib/source/test/lux/world/output/video/resolution.lux @@ -47,7 +47,7 @@ (let [count (list.size ..listing)] (do {! random.monad} [choice (\ ! map (n.% count) random.nat)] - (wrap (maybe.assume (list.nth choice ..listing)))))) + (in (maybe.assume (list.nth choice ..listing)))))) (def: #export test Test diff --git a/stdlib/source/test/lux/world/program.lux b/stdlib/source/test/lux/world/program.lux index 0028cfe9c..6760865e7 100644 --- a/stdlib/source/test/lux/world/program.lux +++ b/stdlib/source/test/lux/world/program.lux @@ -56,15 +56,15 @@ (io.run (do io.monad [actual (/.environment io.monad program)] - (wrap (and (n.= (dictionary.size environment) - (dictionary.size actual)) - (|> actual - dictionary.entries - (list.every? (function (_ [key value]) - (|> environment - (dictionary.get key) - (maybe\map (text\= value)) - (maybe.default false))))))))))) + (in (and (n.= (dictionary.size environment) + (dictionary.size actual)) + (|> actual + dictionary.entries + (list.every? (function (_ [key value]) + (|> environment + (dictionary.get key) + (maybe\map (text\= value)) + (maybe.default false))))))))))) (_.cover [/.unknown_environment_variable] (let [program (/.mock environment home directory)] (|> unknown diff --git a/stdlib/source/test/lux/world/shell.lux b/stdlib/source/test/lux/world/shell.lux index 1cd1473e8..4008c4c5a 100644 --- a/stdlib/source/test/lux/world/shell.lux +++ b/stdlib/source/test/lux/world/shell.lux @@ -36,29 +36,29 @@ (implementation (def: (on_read dead?) (if dead? - (exception.throw ..dead []) + (exception.except ..dead []) (do try.monad [to_echo (try.of_maybe (list.head arguments))] - (wrap [dead? to_echo])))) + (in [dead? to_echo])))) (def: (on_error dead?) (if dead? - (exception.throw ..dead []) + (exception.except ..dead []) (exception.return [dead? ""]))) (def: (on_write message dead?) (if dead? - (exception.throw ..dead []) + (exception.except ..dead []) (#try.Success dead?))) (def: (on_destroy dead?) (if dead? - (exception.throw ..dead []) + (exception.except ..dead []) (#try.Success true))) (def: (on_await dead?) (if dead? - (exception.throw ..dead []) + (exception.except ..dead []) (#try.Success [true /.normal]))))) (def: (io_shell command oops input destruction exit) @@ -96,33 +96,33 @@ destruction (random.ascii/alpha 5) exit random.int #let [shell (/.async (..io_shell command oops input destruction exit))]] - (wrap (do {! async.monad} - [verdict (do (try.with !) - [process (\ shell execute [environment.empty "~" command (list)]) - read (\ process read []) - error (\ process error []) - wrote! (do ! - [write (\ process write input)] - (wrap (#try.Success (case write + (in (do {! async.monad} + [verdict (do (try.with !) + [process (\ shell execute [environment.empty "~" command (list)]) + read (\ process read []) + error (\ process error []) + wrote! (do ! + [write (\ process write input)] + (in (#try.Success (case write + (#try.Success _) + false + + (#try.Failure write) + (text\= input write))))) + destroyed! (do ! + [destroy (\ process destroy [])] + (in (#try.Success (case destroy (#try.Success _) false - (#try.Failure write) - (text\= input write))))) - destroyed! (do ! - [destroy (\ process destroy [])] - (wrap (#try.Success (case destroy - (#try.Success _) - false - - (#try.Failure destroy) - (text\= destruction destroy))))) - await (\ process await [])] - (wrap (and (text\= command read) - (text\= oops error) - wrote! - destroyed! - (i.= exit await))))] - (_.cover' [/.Shell] - (try.default false verdict))))) + (#try.Failure destroy) + (text\= destruction destroy))))) + await (\ process await [])] + (in (and (text\= command read) + (text\= oops error) + wrote! + destroyed! + (i.= exit await))))] + (_.cover' [/.Shell] + (try.default false verdict))))) ))) |