diff options
Diffstat (limited to 'stdlib/source/library')
116 files changed, 1561 insertions, 1494 deletions
diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux index eb2676ee3..4ed6dd7aa 100644 --- a/stdlib/source/library/lux.lux +++ b/stdlib/source/library/lux.lux @@ -749,7 +749,7 @@ (record$ #Nil) #0) -("lux def" fail +("lux def" failure ("lux type check" (#UnivQ #Nil (#Function Text @@ -771,7 +771,7 @@ #Nil)) _ - (fail "Wrong syntax for let''")} + (failure "Wrong syntax for let''")} tokens))) (record$ #.Nil) #0) @@ -808,7 +808,7 @@ #Nil)) _ - (fail "Wrong syntax for function''")} + (failure "Wrong syntax for function''")} tokens))) (record$ #.Nil) #0) @@ -916,7 +916,7 @@ #Nil])) _ - (fail "Wrong syntax for def''")} + (failure "Wrong syntax for def''")} tokens))) (record$ #.Nil) #0) @@ -949,7 +949,7 @@ #Nil)) _ - (fail "Wrong syntax for macro:'")} + (failure "Wrong syntax for macro:'")} tokens))) (record$ #.Nil) #0) @@ -976,7 +976,7 @@ #Nil)) _ - (fail "Wrong syntax for $'")} + (failure "Wrong syntax for $'")} tokens)) (def:'' (list\map f xs) @@ -1102,7 +1102,7 @@ (quantified_args_parser args' (function'' [names] (next (#Cons arg_name names)))) _ - (fail "Expected identifier.")} + (failure "Expected identifier.")} args)) (def:'' (make_parameter idx) @@ -1173,7 +1173,7 @@ #Nil))))) _ - (fail "Wrong syntax for All")} + (failure "Wrong syntax for All")} tokens))) (macro:' #export (Ex tokens) @@ -1217,7 +1217,7 @@ #Nil))))) _ - (fail "Wrong syntax for Ex")} + (failure "Wrong syntax for Ex")} tokens))) (def:'' (list\reverse list) @@ -1244,7 +1244,7 @@ #Nil)) _ - (fail "Wrong syntax for ->")} + (failure "Wrong syntax for ->")} (list\reverse tokens))) (macro:' #export (list xs) @@ -1277,7 +1277,7 @@ init))) _ - (fail "Wrong syntax for list&")} + (failure "Wrong syntax for list&")} (list\reverse xs))) (macro:' #export (& tokens) @@ -1327,7 +1327,7 @@ tokens) ({(#Cons [[_ (#Tuple args)] (#Cons [body #Nil])]) ({#Nil - (fail "function' requires a non-empty arguments tuple.") + (failure "function' requires a non-empty arguments tuple.") (#Cons [harg targs]) (return (list (form$ (list (tuple$ (list (local_identifier$ name) @@ -1341,7 +1341,7 @@ args) _ - (fail "Wrong syntax for function'")} + (failure "Wrong syntax for function'")} tokens'))) (macro:' (def:''' tokens) @@ -1397,7 +1397,7 @@ (bit$ #0))))) _ - (fail "Wrong syntax for def:'''")} + (failure "Wrong syntax for def:'''")} tokens)) (def:''' (as_pairs xs) @@ -1422,7 +1422,7 @@ (list\reverse (as_pairs bindings))))) _ - (fail "Wrong syntax for let'")} + (failure "Wrong syntax for let'")} tokens)) (def:''' (any? p xs) @@ -1496,11 +1496,11 @@ (return (list (list\fold (function/flip (_$_joiner op)) first nexts))) _ - (fail "Wrong syntax for _$")} + (failure "Wrong syntax for _$")} tokens') _ - (fail "Wrong syntax for _$")} + (failure "Wrong syntax for _$")} tokens)) (macro:' #export ($_ tokens) @@ -1518,11 +1518,11 @@ (return (list (list\fold (_$_joiner op) last prevs))) _ - (fail "Wrong syntax for $_")} + (failure "Wrong syntax for $_")} (list\reverse tokens')) _ - (fail "Wrong syntax for $_")} + (failure "Wrong syntax for $_")} tokens)) ## (interface: (Monad m) @@ -1593,7 +1593,7 @@ monad))))) _ - (fail "Wrong syntax for do")} + (failure "Wrong syntax for do")} tokens)) (def:''' (monad\map m f xs) @@ -1648,7 +1648,7 @@ test)))) _ - (fail "Wrong syntax for if")} + (failure "Wrong syntax for if")} tokens)) (def:''' (get k plist) @@ -1899,7 +1899,7 @@ (return (list (form$ (list (tag$ ["library/lux" "Primitive"]) (text$ class_name) (untemplate_list params))))) _ - (fail "Wrong syntax for primitive")} + (failure "Wrong syntax for primitive")} tokens)) (def:'' (current_module_name state) @@ -1932,7 +1932,7 @@ =template))))) _ - (fail "Wrong syntax for `")} + (failure "Wrong syntax for `")} tokens)) (macro:' #export (`' tokens) @@ -1946,7 +1946,7 @@ (wrap (list (form$ (list (text$ "lux type check") (identifier$ ["library/lux" "Code"]) =template))))) _ - (fail "Wrong syntax for `")} + (failure "Wrong syntax for `")} tokens)) (macro:' #export (' tokens) @@ -1960,7 +1960,7 @@ (wrap (list (form$ (list (text$ "lux type check") (identifier$ ["library/lux" "Code"]) =template))))) _ - (fail "Wrong syntax for '")} + (failure "Wrong syntax for '")} tokens)) (macro:' #export (|> tokens) @@ -1986,7 +1986,7 @@ apps))) _ - (fail "Wrong syntax for |>")} + (failure "Wrong syntax for |>")} tokens)) (macro:' #export (<| tokens) @@ -2012,7 +2012,7 @@ apps))) _ - (fail "Wrong syntax for <|")} + (failure "Wrong syntax for <|")} (list\reverse tokens))) (def:''' (compose f g) @@ -2156,15 +2156,15 @@ (list\map (compose apply (make_env bindings'))) list\join return) - (fail "Irregular arguments tuples for template."))) + (failure "Irregular arguments tuples for template."))) _ - (fail "Wrong syntax for template")} + (failure "Wrong syntax for template")} [(monad\map maybe_monad get_short bindings) (monad\map maybe_monad tuple_to_list data)]) _ - (fail "Wrong syntax for template")} + (failure "Wrong syntax for template")} tokens)) (def:''' (n// param subject) @@ -2439,7 +2439,7 @@ (return [key val'']) _ - (fail "The value-part of a KV-pair in a record must macro-expand to a single Code.")} + (failure "The value-part of a KV-pair in a record must macro-expand to a single Code.")} val')))) pairs)] (wrap (list (record$ pairs')))) @@ -2488,11 +2488,11 @@ (wrap (list (walk_type type'))) _ - (fail "The expansion of the type-syntax had to yield a single element.")} + (failure "The expansion of the type-syntax had to yield a single element.")} type+)) _ - (fail "Wrong syntax for type")} + (failure "Wrong syntax for type")} tokens)) (macro:' #export (: tokens) @@ -2504,7 +2504,7 @@ (return (list (` ("lux type check" (type (~ type)) (~ value))))) _ - (fail "Wrong syntax for :")} + (failure "Wrong syntax for :")} tokens)) (macro:' #export (:as tokens) @@ -2516,7 +2516,7 @@ (return (list (` ("lux type as" (type (~ type)) (~ value))))) _ - (fail "Wrong syntax for :as")} + (failure "Wrong syntax for :as")} tokens)) (def:''' (empty? xs) @@ -2547,7 +2547,7 @@ (return [member_name member_type]) _ - (fail "Wrong syntax for variant case.")} + (failure "Wrong syntax for variant case.")} pair))) pairs)] (return [(` (& (~+ (list\map second members)))) @@ -2579,14 +2579,14 @@ (return [member_name (` (& (~+ member_types)))]) _ - (fail "Wrong syntax for variant case.")} + (failure "Wrong syntax for variant case.")} case))) (list& case cases))] (return [(` (| (~+ (list\map second members)))) (#Some (list\map first members))])) _ - (fail "Improper type-definition syntax")} + (failure "Improper type-definition syntax")} type_codes)) (def:''' (gensym prefix state) @@ -2617,7 +2617,7 @@ (return (list (` (#.Apply .Nothing (#.UnivQ #.Nil (~ body'))))))) _ - (fail "Wrong syntax for Rec")} + (failure "Wrong syntax for Rec")} tokens)) (macro:' #export (exec tokens) @@ -2638,7 +2638,7 @@ actions)))) _ - (fail "Wrong syntax for exec")} + (failure "Wrong syntax for exec")} (list\reverse tokens))) (macro:' (def:' tokens) @@ -2684,7 +2684,7 @@ (~ (bit$ export?))))))) #None - (fail "Wrong syntax for def'")} + (failure "Wrong syntax for def'")} parts))) (def:' (rejoin_pair pair) @@ -2775,11 +2775,11 @@ (do meta_monad [] (wrap (list))) _ - (fail ($_ text\compose "'lux.case' expects an even number of tokens: " (|> branches - (list\map code\encode) - (interpose " ") - list\reverse - (list\fold text\compose ""))))} + (failure ($_ text\compose "'lux.case' expects an even number of tokens: " (|> branches + (list\map code\encode) + (interpose " ") + list\reverse + (list\fold text\compose ""))))} branches)) (macro:' #export (case tokens) @@ -2798,7 +2798,7 @@ (wrap (list (` ((~ (record$ (as_pairs expansion))) (~ value)))))) _ - (fail "Wrong syntax for case")} + (failure "Wrong syntax for case")} tokens)) (macro:' #export (^ tokens) @@ -2821,10 +2821,10 @@ (wrap (list& pattern' body branches)) _ - (fail "^ can only expand to 1 pattern."))) + (failure "^ can only expand to 1 pattern."))) _ - (fail "Wrong syntax for ^ macro"))) + (failure "Wrong syntax for ^ macro"))) (macro:' #export (^or tokens) (list [(tag$ ["library/lux" "doc"]) @@ -2845,7 +2845,7 @@ (^ (list& [_ (#Form patterns)] body branches)) (case patterns #Nil - (fail "^or cannot have 0 patterns") + (failure "^or cannot have 0 patterns") _ (let' [pairs (|> patterns @@ -2853,7 +2853,7 @@ (list\join))] (return (list\compose pairs branches)))) _ - (fail "Wrong syntax for ^or"))) + (failure "Wrong syntax for ^or"))) (def:' (identifier? code) (-> Code Bit) @@ -2885,10 +2885,10 @@ body) list return) - (fail "let requires an even number of parts")) + (failure "let requires an even number of parts")) _ - (fail "Wrong syntax for let"))) + (failure "Wrong syntax for let"))) (macro:' #export (function tokens) (list [(tag$ ["library/lux" "doc"]) @@ -2920,7 +2920,7 @@ (list\fold (nest g!blank) body (list\reverse tail)))))) #None - (fail "Wrong syntax for function"))) + (failure "Wrong syntax for function"))) (def:' (process_def_meta_value code) (-> Code Code) @@ -3069,7 +3069,7 @@ (~ (bit$ exported?))))))) #None - (fail "Wrong syntax for def:")))) + (failure "Wrong syntax for def:")))) (def: (meta_code_add addition meta) (-> [Code Code] Code Code) @@ -3101,7 +3101,7 @@ " ([#Identifier] [#Tag])" __paragraph " _" ..\n - " (fail ''Wrong syntax for name_of'')))"))]) + " (failure ''Wrong syntax for name_of'')))"))]) (let [[exported? tokens] (export^ tokens) name+args+meta+body?? (: (Maybe [Name (List Code) (List [Code Code]) Code]) (case tokens @@ -3137,7 +3137,7 @@ (~ (bit$ exported?))))))) #None - (fail "Wrong syntax for macro:")))) + (failure "Wrong syntax for macro:")))) (macro: #export (interface: tokens) {#.doc (text$ ($_ "lux text concat" @@ -3184,7 +3184,7 @@ (wrap [name type]) _ - (fail "Signatures require typed members!")))) + (failure "Signatures require typed members!")))) (list\join sigs'))) #let [[_module _name] name+ def_name (identifier$ name) @@ -3203,7 +3203,7 @@ (return (list (` (..type: (~+ (export exported?)) (~ usage) (~ sig_meta) (~ sig_type)))))) #None - (fail "Wrong syntax for interface:")))) + (failure "Wrong syntax for interface:")))) (def: (find f xs) (All [a b] @@ -3231,7 +3231,7 @@ init))) _ - (fail <message>)))] + (failure <message>)))] [and (if (~ pre) (~ post) #0) "'and' requires >=1 clauses." "Short-circuiting 'and': (and #1 #0 #1) ## => #0"] [or (if (~ pre) #1 (~ post)) "'or' requires >=1 clauses." "Short-circuiting 'or': (or #1 #0 #1) ## => #1"]) @@ -3444,7 +3444,7 @@ (return output) _ - (fail (text\compose "Unknown tag: " (name\encode [module name])))))) + (failure (text\compose "Unknown tag: " (name\encode [module name])))))) (def: (resolve_type_tags type) (-> Type (Meta (Maybe [(List Name) (List Type)]))) @@ -3503,7 +3503,7 @@ (return tags) _ - (fail "No tags available for type."))) + (failure "No tags available for type."))) #let [tag_mappings (: (List [Text Code]) (list\map (function (_ tag) [(second tag) (tag$ tag)]) tags))] @@ -3517,10 +3517,10 @@ (wrap [tag value]) _ - (fail (text\compose "Unknown implementation member: " tag_name))) + (failure (text\compose "Unknown implementation member: " tag_name))) _ - (fail "Invalid implementation member.")))) + (failure "Invalid implementation member.")))) (list\join tokens'))] (wrap (list (record$ members))))) @@ -3583,7 +3583,7 @@ (implementation (~+ definitions))))))) #None - (fail "Wrong syntax for implementation:")))) + (failure "Wrong syntax for implementation:")))) (def: (function\identity x) (All [a] (-> a a)) x) @@ -3669,10 +3669,10 @@ (~ (bit$ exported?)))))))) #None - (fail "Wrong syntax for type:")))) + (failure "Wrong syntax for type:")))) #None - (fail "Wrong syntax for type:")) + (failure "Wrong syntax for type:")) )) (template [<name> <to>] @@ -3715,7 +3715,7 @@ (return name) _ - (fail "#only/#+ and #exclude/#- require identifiers.")))) + (failure "#only/#+ and #exclude/#- require identifiers.")))) defs)) (def: (referrals_parser tokens) @@ -3759,7 +3759,7 @@ (return struct_name) _ - (fail "Expected all implementations of opening form to be identifiers."))) + (failure "Expected all implementations of opening form to be identifiers."))) structs) next+remainder (openings_parser parts')] (let [[next remainder] next+remainder] @@ -3809,24 +3809,24 @@ (def: parallel_hierarchy_sigil "\") -(def: (normalize_parallel_path' hierarchy root) +(def: (normal_parallel_path' hierarchy root) (-> Text Text Text) (case [(text\split_with ..module_separator hierarchy) (text\split_with ..parallel_hierarchy_sigil root)] [(#.Some [_ hierarchy']) (#.Some ["" root'])] - (normalize_parallel_path' hierarchy' root') + (normal_parallel_path' hierarchy' root') _ (case root "" hierarchy _ ($_ text\compose root ..module_separator hierarchy)))) -(def: (normalize_parallel_path hierarchy root) +(def: (normal_parallel_path hierarchy root) (-> Text Text (Maybe Text)) (case (text\split_with ..parallel_hierarchy_sigil root) (#.Some ["" root']) - (#.Some (normalize_parallel_path' hierarchy root')) + (#.Some (normal_parallel_path' hierarchy root')) _ #.None)) @@ -3883,10 +3883,10 @@ 0 prefix _ ($_ text\compose prefix ..module_separator clean))] (return output)) - (fail ($_ "lux text concat" - "Cannot climb the module hierarchy..." ..\n - "Importing module: " module ..\n - " Relative Root: " relative_root ..\n)))))) + (failure ($_ "lux text concat" + "Cannot climb the module hierarchy..." ..\n + "Importing module: " module ..\n + " Relative Root: " relative_root ..\n)))))) (def: (alter_domain alteration domain import) (-> Nat Text Importation Importation) @@ -3922,7 +3922,7 @@ ## Nested (^ [_ (#Tuple (list& [_ (#Identifier ["" m_name])] extra))]) (do meta_monad - [import_name (case (normalize_parallel_path relative_root m_name) + [import_name (case (normal_parallel_path relative_root m_name) (#.Some parallel_path) (wrap parallel_path) @@ -3946,7 +3946,7 @@ (^ [_ (#Tuple (list& [_ (#Text alias)] [_ (#Identifier ["" m_name])] extra))]) (do meta_monad - [import_name (case (normalize_parallel_path relative_root m_name) + [import_name (case (normal_parallel_path relative_root m_name) (#.Some parallel_path) (wrap parallel_path) @@ -3973,9 +3973,9 @@ _ (do meta_monad [current_module current_module_name] - (fail ($_ text\compose - "Wrong syntax for import @ " current_module - ..\n (code\encode token))))))) + (failure ($_ text\compose + "Wrong syntax for import @ " current_module + ..\n (code\encode token))))))) imports)] (wrap (list\join imports')))) @@ -4171,13 +4171,13 @@ temp)) ))) -(def: (zip/2 xs ys) +(def: (zipped/2 xs ys) (All [a b] (-> (List a) (List b) (List [a b]))) (case xs (#Cons x xs') (case ys (#Cons y ys') - (list& [x y] (zip/2 xs' ys')) + (list& [x y] (zipped/2 xs' ys')) _ (list)) @@ -4250,7 +4250,7 @@ struct_evidence (resolve_type_tags init_type)] (case struct_evidence #None - (fail (text\compose "Can only 'open' structs: " (type\encode init_type))) + (failure (text\compose "Can only 'open' structs: " (type\encode init_type))) (#Some tags&members) (do meta_monad @@ -4274,13 +4274,13 @@ #None (wrap enhanced_target)))) target - (zip/2 locals members))] + (zipped/2 locals members))] (wrap (` ({(~ pattern) (~ enhanced_target)} (~ (identifier$ source))))))))) name tags&members body)] (wrap (list full_body))))) _ - (fail "Wrong syntax for ^open"))) + (failure "Wrong syntax for ^open"))) (macro: #export (cond tokens) {#.doc (text$ ($_ "lux text concat" @@ -4291,7 +4291,7 @@ " ## else_branch" ..\n " ''???'')"))} (if ("lux i64 =" 0 (n/% 2 (list\size tokens))) - (fail "cond requires an uneven number of arguments.") + (failure "cond requires an uneven number of arguments.") (case (list\reverse tokens) (^ (list& else branches')) (return (list (list\fold (: (-> [Code Code] Code Code) @@ -4302,7 +4302,7 @@ (as_pairs branches')))) _ - (fail "Wrong syntax for cond")))) + (failure "Wrong syntax for cond")))) (def: (enumeration' idx xs) (All [a] (-> Nat (List a) (List [Nat a]))) @@ -4344,11 +4344,11 @@ (if ("lux i64 =" idx r_idx) g!output g!_)])) - (zip/2 tags (enumeration members))))] + (zipped/2 tags (enumeration members))))] (return (list (` ({(~ pattern) (~ g!output)} (~ record)))))) _ - (fail "get@ can only use records."))) + (failure "get@ can only use records."))) (^ (list [_ (#Tuple slots)] record)) (return (list (list\fold (: (-> Code Code Code) @@ -4364,7 +4364,7 @@ (wrap (list (` (function ((~ g!_) (~ g!record)) (..get@ (~ selector) (~ g!record))))))) _ - (fail "Wrong syntax for get@"))) + (failure "Wrong syntax for get@"))) (def: (open_field alias tags my_tag_index [module short] source type) (-> Text (List Name) Nat Name Code Type (Meta (List Code))) @@ -4387,7 +4387,7 @@ (: (-> [Nat Name Type] (Meta (List Code))) (function (_ [sub_tag_index sname stype]) (open_field alias tags' sub_tag_index sname source+ stype))) - (enumeration (zip/2 tags' members')))] + (enumeration (zipped/2 tags' members')))] (return (list\join decls'))) _ @@ -4422,11 +4422,11 @@ [decls' (monad\map meta_monad (: (-> [Nat Name Type] (Meta (List Code))) (function (_ [tag_index sname stype]) (open_field alias tags tag_index sname source stype))) - (enumeration (zip/2 tags members)))] + (enumeration (zipped/2 tags members)))] (return (list\join decls'))) _ - (fail (text\compose "Can only 'open:' structs: " (type\encode struct_type))))) + (failure (text\compose "Can only 'open:' structs: " (type\encode struct_type))))) _ (do meta_monad @@ -4437,7 +4437,7 @@ (` (..open: (~ (text$ alias)) (~ g!struct))))))) _ - (fail "Wrong syntax for open:"))) + (failure "Wrong syntax for open:"))) (macro: #export (|>> tokens) {#.doc (text$ ($_ "lux text concat" @@ -4482,11 +4482,11 @@ #refer_open openings}) _ - (fail ($_ text\compose "Wrong syntax for refer @ " current_module - ..\n (|> options - (list\map code\encode) - (interpose " ") - (list\fold text\compose ""))))))) + (failure ($_ text\compose "Wrong syntax for refer @ " current_module + ..\n (|> options + (list\map code\encode) + (interpose " ") + (list\fold text\compose ""))))))) (def: (write_refer module_name [r_defs r_opens]) (-> Text Refer (Meta (List Code))) @@ -4499,7 +4499,7 @@ (function (_ _def) (if (is_member? all_defs _def) (return []) - (fail ($_ text\compose _def " is not defined in module " module_name " @ " current_module))))) + (failure ($_ text\compose _def " is not defined in module " module_name " @ " current_module))))) referred_defs)))] defs' (case r_defs #All @@ -4544,7 +4544,7 @@ (write_refer module_name =refer)) _ - (fail "Wrong syntax for refer"))) + (failure "Wrong syntax for refer"))) (def: (refer_to_code module_name module_alias' [r_defs r_opens]) (-> Text (Maybe Text) Refer Code) @@ -4630,7 +4630,7 @@ (return (list (` ((..\ (~ struct) (~ member)) (~+ args))))) _ - (fail "Wrong syntax for \"))) + (failure "Wrong syntax for \"))) (macro: #export (set@ tokens) {#.doc (text$ ($_ "lux text concat" @@ -4658,7 +4658,7 @@ (do meta_monad [g!slot (gensym "")] (return [r_slot_name r_idx g!slot])))) - (zip/2 tags (enumeration members)))] + (zipped/2 tags (enumeration members)))] (let [pattern (record$ (list\map (: (-> [Name Nat Code] [Code Code]) (function (_ [r_slot_name r_idx r_var]) [(tag$ r_slot_name) @@ -4674,12 +4674,12 @@ (return (list (` ({(~ pattern) (~ output)} (~ record))))))) _ - (fail "set@ can only use records."))) + (failure "set@ can only use records."))) (^ (list [_ (#Tuple slots)] value record)) (case slots #Nil - (fail "Wrong syntax for set@") + (failure "Wrong syntax for set@") _ (do meta_monad @@ -4687,7 +4687,7 @@ (: (-> Code (Meta Code)) (function (_ _) (gensym "temp"))) slots) - #let [pairs (zip/2 slots bindings) + #let [pairs (zipped/2 slots bindings) update_expr (list\fold (: (-> [Code Code] Code Code) (function (_ [s b] v) (` (..set@ (~ s) (~ v) (~ b))))) @@ -4719,7 +4719,7 @@ (..set@ (~ selector) (~ g!value) (~ g!record))))))) _ - (fail "Wrong syntax for set@"))) + (failure "Wrong syntax for set@"))) (macro: #export (update@ tokens) {#.doc (text$ ($_ "lux text concat" @@ -4747,7 +4747,7 @@ (do meta_monad [g!slot (gensym "")] (return [r_slot_name r_idx g!slot])))) - (zip/2 tags (enumeration members)))] + (zipped/2 tags (enumeration members)))] (let [pattern (record$ (list\map (: (-> [Name Nat Code] [Code Code]) (function (_ [r_slot_name r_idx r_var]) [(tag$ r_slot_name) @@ -4763,12 +4763,12 @@ (return (list (` ({(~ pattern) (~ output)} (~ record))))))) _ - (fail "update@ can only use records."))) + (failure "update@ can only use records."))) (^ (list [_ (#Tuple slots)] fun record)) (case slots #Nil - (fail "Wrong syntax for update@") + (failure "Wrong syntax for update@") _ (do meta_monad @@ -4794,7 +4794,7 @@ (..update@ (~ selector) (~ g!fun) (~ g!record))))))) _ - (fail "Wrong syntax for update@"))) + (failure "Wrong syntax for update@"))) (macro: #export (^template tokens) {#.doc (text$ ($_ "lux text concat" @@ -4854,10 +4854,10 @@ (return (list\compose output branches)) #None - (fail "Wrong syntax for ^template")) + (failure "Wrong syntax for ^template")) _ - (fail "Wrong syntax for ^template"))) + (failure "Wrong syntax for ^template"))) (def: (find_baseline_column code) (-> Code Nat) @@ -5097,7 +5097,7 @@ [inits' (: (Meta (List Name)) (case (monad\map maybe_monad get_name inits) (#Some inits') (return inits') - #None (fail "Wrong syntax for loop"))) + #None (failure "Wrong syntax for loop"))) init_types (monad\map meta_monad find_type inits') expected get_expected_type] (return (list (` (("lux type check" @@ -5117,7 +5117,7 @@ (~ body))))))))) #.None - (fail "Wrong syntax for loop")))) + (failure "Wrong syntax for loop")))) (macro: #export (^slots tokens) {#.doc (doc "Allows you to extract record members as local variables with the same names." @@ -5137,7 +5137,7 @@ (return slots) #None - (fail "Wrong syntax for ^slots"))) + (failure "Wrong syntax for ^slots"))) #let [[hslot tslots] slots] hslot (normalize hslot) tslots (monad\map meta_monad normalize tslots) @@ -5158,7 +5158,7 @@ (return (list& pattern body branches))) _ - (fail "Wrong syntax for ^slots"))) + (failure "Wrong syntax for ^slots"))) (def: (place_tokens label tokens target) (-> Text (List Code) Code (Maybe (List Code))) @@ -5231,16 +5231,16 @@ (wrap output) _ - (fail "[with_expansions] Improper macro expansion."))) + (failure "[with_expansions] Improper macro expansion."))) #Nil (return bodies) _ - (fail "Wrong syntax for with_expansions")) + (failure "Wrong syntax for with_expansions")) _ - (fail "Wrong syntax for with_expansions"))) + (failure "Wrong syntax for with_expansions"))) (def: (flat_alias type) (-> Type Type) @@ -5278,7 +5278,7 @@ ["Text" Text text$]) _ - (fail (text\compose "Cannot anti-quote type: " (name\encode name)))))) + (failure (text\compose "Cannot anti-quote type: " (name\encode name)))))) (def: (anti_quote token) (-> Code (Meta Code)) @@ -5323,7 +5323,7 @@ (wrap (list pattern'))) _ - (fail "Wrong syntax for 'static'."))) + (failure "Wrong syntax for 'static'."))) (type: Multi_Level_Case [Code (List [Code Code])]) @@ -5342,7 +5342,7 @@ (-> (List Code) (Meta Multi_Level_Case)) (case levels #Nil - (fail "Multi-level patterns cannot be empty.") + (failure "Multi-level patterns cannot be empty.") (#Cons init extras) (do meta_monad @@ -5419,7 +5419,7 @@ (wrap output))) _ - (fail "Wrong syntax for ^multi"))) + (failure "Wrong syntax for ^multi"))) ## TODO: Allow asking the compiler for the name of the definition ## currently being defined. That name can then be fed into @@ -5441,7 +5441,7 @@ ([#Identifier] [#Tag]) _ - (fail (..wrong_syntax_error ["library/lux" "name_of"])))) + (failure (..wrong_syntax_error ["library/lux" "name_of"])))) (def: (get_scope_type_vars state) (Meta (List Nat)) @@ -5471,10 +5471,10 @@ (wrap (list (` (#Ex (~ (nat$ var_id)))))) #None - (fail (text\compose "Indexed-type does not exist: " (nat\encode idx))))) + (failure (text\compose "Indexed-type does not exist: " (nat\encode idx))))) _ - (fail (..wrong_syntax_error (name_of ..$))))) + (failure (..wrong_syntax_error (name_of ..$))))) (def: #export (is? reference sample) {#.doc (doc "Tests whether the 2 values are identical (not just 'equal')." @@ -5501,7 +5501,7 @@ branches))) _ - (fail (..wrong_syntax_error (name_of ..^@))))) + (failure (..wrong_syntax_error (name_of ..^@))))) (macro: #export (^|> tokens) {#.doc (doc "Pipes the value being pattern-matched against prior to binding it to a variable." @@ -5517,7 +5517,7 @@ branches))) _ - (fail (..wrong_syntax_error (name_of ..^|>))))) + (failure (..wrong_syntax_error (name_of ..^|>))))) (macro: #export (:assume tokens) {#.doc (doc "Coerces the given expression to the type of whatever is expected." @@ -5529,7 +5529,7 @@ (wrap (list (` ("lux type as" (~ (type_to_code type)) (~ expr)))))) _ - (fail (..wrong_syntax_error (name_of ..:assume))))) + (failure (..wrong_syntax_error (name_of ..:assume))))) (def: location {#.doc "The location of the current expression being analyzed."} @@ -5554,7 +5554,7 @@ (wrap (list (` (..error! (~ (text$ message))))))) _ - (fail (..wrong_syntax_error (name_of ..undefined))))) + (failure (..wrong_syntax_error (name_of ..undefined))))) (macro: #export (:of tokens) {#.doc (doc "Generates the type corresponding to a given expression." @@ -5581,7 +5581,7 @@ (..:of (~ g!temp))))))) _ - (fail (..wrong_syntax_error (name_of ..:of))))) + (failure (..wrong_syntax_error (name_of ..:of))))) (def: (complex_declaration_parser tokens) (-> (List Code) (Meta [[Text (List Text)] (List Code)])) @@ -5595,12 +5595,12 @@ (wrap arg_name) _ - (fail "Could not parse an argument."))) + (failure "Could not parse an argument."))) args')] (wrap [[name args] tokens'])) _ - (fail "Could not parse a complex declaration.") + (failure "Could not parse a complex declaration.") )) (def: (any_parser tokens) @@ -5610,7 +5610,7 @@ (return [token tokens']) _ - (fail "Could not parse anything.") + (failure "Could not parse anything.") )) (def: (many_parser tokens) @@ -5620,7 +5620,7 @@ (return [tokens (list)]) _ - (fail "Could not parse anything.") + (failure "Could not parse anything.") )) (def: (end_parser tokens) @@ -5630,7 +5630,7 @@ (return []) _ - (fail "Expected input Codes to be empty.") + (failure "Expected input Codes to be empty.") )) (def: (anns_parser tokens) @@ -5715,14 +5715,14 @@ (wrap (:as ..Text value)) _ - (fail ($_ text\compose - "Invalid target platform (must be a value of type Text): " (name\encode identifier) - " : " (..code\encode (..type_to_code type)))))) + (failure ($_ text\compose + "Invalid target platform (must be a value of type Text): " (name\encode identifier) + " : " (..code\encode (..type_to_code type)))))) _ - (fail ($_ text\compose - "Invalid target platform syntax: " (..code\encode choice) - ..\n "Must be either a text literal or an identifier.")))) + (failure ($_ text\compose + "Invalid target platform syntax: " (..code\encode choice) + ..\n "Must be either a text literal or an identifier.")))) (def: (target_pick target options default) (-> Text (List [Code Code]) (Maybe Code) (Meta (List Code))) @@ -5730,7 +5730,7 @@ #Nil (case default #.None - (fail ($_ text\compose "No code for target platform: " target)) + (failure ($_ text\compose "No code for target platform: " target)) (#.Some default) (return (list default))) @@ -5753,7 +5753,7 @@ (target_pick target options (#.Some default)) _ - (fail (..wrong_syntax_error (name_of ..for)))))) + (failure (..wrong_syntax_error (name_of ..for)))))) (template [<name> <type> <output>] [(def: (<name> xy) @@ -5809,7 +5809,7 @@ (~ labelled)))))) _ - (fail (..wrong_syntax_error (name_of ..``))) + (failure (..wrong_syntax_error (name_of ..``))) )) (def: (name$ [module name]) @@ -5879,7 +5879,7 @@ (return unquoted) [_ (#Form (#Cons [[_ (#Identifier ["" "~+"])] (#Cons [spliced #Nil])]))] - (fail "Cannot use (~+) inside of ^code unless it is the last element in a form or a tuple.") + (failure "Cannot use (~+) inside of ^code unless it is the last element in a form or a tuple.") (^template [<tag> <untemplate>] [[_ (<tag> elems)] @@ -5904,7 +5904,7 @@ (wrap (list pattern))) _ - (fail (..wrong_syntax_error (name_of ..^code))))) + (failure (..wrong_syntax_error (name_of ..^code))))) (def: #export false Bit @@ -5924,10 +5924,10 @@ (list localT (` (..as_is (~ valueT)))))) (list\fold list\compose (list))))] (~ bodyT))))) - (..fail ":let requires an even number of parts")) + (..failure ":let requires an even number of parts")) _ - (..fail (..wrong_syntax_error (name_of ..:let))))) + (..failure (..wrong_syntax_error (name_of ..:let))))) (macro: #export (try tokens) {#.doc (doc (case (try (risky_computation input)) @@ -5945,4 +5945,4 @@ (~ expression))))))) _ - (..fail (..wrong_syntax_error (name_of ..try))))) + (..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 0f63efc65..da787a54a 100644 --- a/stdlib/source/library/lux/abstract/apply.lux +++ b/stdlib/source/library/lux/abstract/apply.lux @@ -13,25 +13,25 @@ (-> (f (-> a b)) (f a) (f b))) apply)) -(implementation: #export (compose f-monad f-apply g-apply) +(implementation: #export (compose f_monad f_apply g_apply) {#.doc "Applicative functor composition."} (All [F G] (-> (Monad F) (Apply F) (Apply G) ## TODO: Replace (All [a] (F (G a))) with (functor.Then F G) (Apply (All [a] (F (G a)))))) - (def: &functor (functor.compose (get@ #&functor f-apply) (get@ #&functor g-apply))) + (def: &functor (functor.compose (get@ #&functor f_apply) (get@ #&functor g_apply))) (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)) + (let [fgf' (\ f_apply apply + (\ f_monad wrap (\ g_apply apply)) fgf)] - (\ f-apply apply fgf' fgx)) - ## (let [applyF (\ f-apply apply) - ## applyG (\ g-apply apply)] + (\ f_apply apply fgf' fgx)) + ## (let [applyF (\ f_apply apply) + ## applyG (\ g_apply apply)] ## ($_ applyF - ## (\ f-monad wrap applyG) + ## (\ f_monad wrap applyG) ## fgf ## fgx)) )) diff --git a/stdlib/source/library/lux/abstract/codec.lux b/stdlib/source/library/lux/abstract/codec.lux index 2d734673f..097c8ca84 100644 --- a/stdlib/source/library/lux/abstract/codec.lux +++ b/stdlib/source/library/lux/abstract/codec.lux @@ -14,16 +14,16 @@ (: (-> m (Try a)) decode)) -(implementation: #export (compose cb-codec ba-codec) +(implementation: #export (compose cb_codec ba_codec) {#.doc "Codec composition."} (All [a b c] (-> (Codec c b) (Codec b a) (Codec c a))) (def: encode - (|>> (\ ba-codec encode) - (\ cb-codec encode))) + (|>> (\ ba_codec encode) + (\ cb_codec encode))) (def: (decode cy) (do try.monad - [by (\ cb-codec decode cy)] - (\ ba-codec decode by)))) + [by (\ cb_codec decode cy)] + (\ ba_codec decode by)))) diff --git a/stdlib/source/library/lux/abstract/comonad/cofree.lux b/stdlib/source/library/lux/abstract/comonad/cofree.lux index c0236f079..88c4ce50a 100644 --- a/stdlib/source/library/lux/abstract/comonad/cofree.lux +++ b/stdlib/source/library/lux/abstract/comonad/cofree.lux @@ -6,7 +6,7 @@ [functor (#+ Functor)]]]) (type: #export (CoFree F a) - {#.doc "The CoFree CoMonad."} + {#.doc (doc "The CoFree CoMonad.")} [a (F (CoFree F a))]) (implementation: #export (functor dsl) diff --git a/stdlib/source/library/lux/abstract/equivalence.lux b/stdlib/source/library/lux/abstract/equivalence.lux index bb21f7711..b1e570713 100644 --- a/stdlib/source/library/lux/abstract/equivalence.lux +++ b/stdlib/source/library/lux/abstract/equivalence.lux @@ -11,6 +11,7 @@ =)) (def: #export (rec sub) + {#.doc (doc "A recursive equivalence combinator.")} (All [a] (-> (-> (Equivalence a) (Equivalence a)) (Equivalence a))) (implementation (def: (= left right) diff --git a/stdlib/source/library/lux/abstract/fold.lux b/stdlib/source/library/lux/abstract/fold.lux index 58059e634..fca10ecb2 100644 --- a/stdlib/source/library/lux/abstract/fold.lux +++ b/stdlib/source/library/lux/abstract/fold.lux @@ -11,6 +11,7 @@ fold)) (def: #export (with_monoid monoid fold value) + {#.doc (doc "Fold over a foldable structure using the monoid's identity as the initial value.")} (All [F a] (-> (Monoid a) (Fold F) (F a) a)) (let [(^open "/\.") monoid] diff --git a/stdlib/source/library/lux/abstract/functor.lux b/stdlib/source/library/lux/abstract/functor.lux index fb56625e8..f168eebe0 100644 --- a/stdlib/source/library/lux/abstract/functor.lux +++ b/stdlib/source/library/lux/abstract/functor.lux @@ -1,5 +1,6 @@ -(.module: [library - lux]) +(.module: + [library + [lux #*]]) (interface: #export (Functor f) (: (All [a b] @@ -14,6 +15,7 @@ (All [a] (| (f a) (g a)))) (def: #export (sum (^open "f\.") (^open "g\.")) + {#.doc (doc "Co-product (sum) composition for functors.")} (All [F G] (-> (Functor F) (Functor G) (Functor (..Or F G)))) (implementation (def: (map f fa|ga) @@ -28,6 +30,7 @@ (All [a] (& (f a) (g a)))) (def: #export (product (^open "f\.") (^open "g\.")) + {#.doc (doc "Product composition for functors.")} (All [F G] (-> (Functor F) (Functor G) (Functor (..And F G)))) (implementation (def: (map f [fa ga]) diff --git a/stdlib/source/library/lux/abstract/interval.lux b/stdlib/source/library/lux/abstract/interval.lux index 5fbf26109..4d4e5f643 100644 --- a/stdlib/source/library/lux/abstract/interval.lux +++ b/stdlib/source/library/lux/abstract/interval.lux @@ -26,6 +26,7 @@ (def: top top))) (def: #export (singleton enum elem) + {#.doc (doc "An interval where both top and bottom are the same value.")} (All [a] (-> (Enum a) a (Interval a))) (implementation (def: &enum enum) @@ -69,31 +70,34 @@ ) (def: #export (borders? interval elem) + {#.doc (doc "Where a value is at the border of an interval.")} (All [a] (-> (Interval a) a Bit)) (or (starts_with? elem interval) (ends_with? elem interval))) -(def: #export (union left right) +(implementation: #export (union left right) + {#.doc (doc "An interval that spans both predecessors.")} (All [a] (-> (Interval a) (Interval a) (Interval a))) - (implementation - (def: &enum (get@ #&enum right)) - (def: bottom (order.min (\ right &order) (\ left bottom) (\ right bottom))) - (def: top (order.max (\ right &order) (\ left top) (\ right top))))) -(def: #export (intersection left right) + (def: &enum (get@ #&enum right)) + (def: bottom (order.min (\ right &order) (\ left bottom) (\ right bottom))) + (def: top (order.max (\ right &order) (\ left top) (\ right top)))) + +(implementation: #export (intersection left right) + {#.doc (doc "An interval spanned by both predecessors.")} (All [a] (-> (Interval a) (Interval a) (Interval a))) - (implementation - (def: &enum (get@ #&enum right)) - (def: bottom (order.max (\ right &order) (\ left bottom) (\ right bottom))) - (def: top (order.min (\ right &order) (\ left top) (\ right top))))) -(def: #export (complement interval) + (def: &enum (get@ #&enum right)) + (def: bottom (order.max (\ right &order) (\ left bottom) (\ right bottom))) + (def: top (order.min (\ right &order) (\ left top) (\ right top)))) + +(implementation: #export (complement interval) + {#.doc (doc "The inverse of an interval.")} (All [a] (-> (Interval a) (Interval a))) - (let [(^open ".") interval] - (implementation - (def: &enum (get@ #&enum interval)) - (def: bottom (succ top)) - (def: top (pred bottom))))) + + (def: &enum (get@ #&enum interval)) + (def: bottom (\ interval succ (\ interval top))) + (def: top (\ interval pred (\ interval bottom)))) (def: #export (precedes? reference sample) (All [a] (-> (Interval a) (Interval a) Bit)) @@ -118,6 +122,7 @@ ) (def: #export (meets? reference sample) + {#.doc (doc "Whether an interval meets another one on its bottom/lower side.")} (All [a] (-> (Interval a) (Interval a) Bit)) (let [(^open ",\.") reference limit (\ reference bottom)] @@ -143,7 +148,9 @@ [finishes? ,\top order.>= ,\bottom] ) -(implementation: #export equivalence (All [a] (Equivalence (Interval a))) +(implementation: #export equivalence + (All [a] (Equivalence (Interval a))) + (def: (= reference sample) (let [(^open ",\.") reference] (and (,\= ,\bottom (\ sample bottom)) diff --git a/stdlib/source/library/lux/abstract/monad.lux b/stdlib/source/library/lux/abstract/monad.lux index ef7138593..567234801 100644 --- a/stdlib/source/library/lux/abstract/monad.lux +++ b/stdlib/source/library/lux/abstract/monad.lux @@ -44,6 +44,9 @@ #.Nil)) (interface: #export (Monad m) + {#.doc (doc "A monad is a monoid in the category of endofunctors." + "What's the problem?")} + (: (Functor m) &functor) (: (All [a] @@ -108,6 +111,7 @@ (#.Left "Wrong syntax for 'do'"))) (def: #export (bind monad f) + {#.doc (doc "Apply a function with monadic effects to a monadic value and yield a new monadic value.")} (All [! a b] (-> (Monad !) (-> a (! b)) (-> (! a) (! b)))) diff --git a/stdlib/source/library/lux/abstract/monad/indexed.lux b/stdlib/source/library/lux/abstract/monad/indexed.lux index 92db5f045..5d18ba0ac 100644 --- a/stdlib/source/library/lux/abstract/monad/indexed.lux +++ b/stdlib/source/library/lux/abstract/monad/indexed.lux @@ -3,8 +3,8 @@ [lux #* [control [monad] - ["p" parser - ["s" code (#+ Parser)]]] + ["<>" parser + ["<.>" code (#+ Parser)]]] [data [collection ["." list ("#\." functor fold)]]] @@ -23,11 +23,12 @@ (m ii io vo))) bind)) -(type: Binding [Code Code]) +(type: Binding + [Code Code]) (def: binding (Parser Binding) - (p.and s.any s.any)) + (<>.and <code>.any <code>.any)) (type: Context (#Let (List Binding)) @@ -35,9 +36,9 @@ (def: context (Parser Context) - (p.or (p.after (s.this! (' #let)) - (s.tuple (p.some binding))) - binding)) + (<>.or (<>.after (<code>.this! (' #let)) + (<code>.tuple (<>.some binding))) + binding)) (def: (pair_list [binding value]) (All [a] (-> [a a] (List a))) @@ -45,14 +46,14 @@ (def: named_monad (Parser [(Maybe Text) Code]) - (p.either (s.record (p.and (\ p.monad map (|>> #.Some) - s.local_identifier) - s.any)) - (\ p.monad map (|>> [#.None]) - s.any))) + (<>.either (<code>.record (<>.and (\ <>.monad map (|>> #.Some) + <code>.local_identifier) + <code>.any)) + (\ <>.monad map (|>> [#.None]) + <code>.any))) (syntax: #export (do {[?name monad] ..named_monad} - {context (s.tuple (p.some context))} + {context (<code>.tuple (<>.some context))} expression) (macro.with_gensyms [g!_ g!bind] (let [body (list\fold (function (_ context next) diff --git a/stdlib/source/library/lux/abstract/order.lux b/stdlib/source/library/lux/abstract/order.lux index 3eaafaf3a..280226ccd 100644 --- a/stdlib/source/library/lux/abstract/order.lux +++ b/stdlib/source/library/lux/abstract/order.lux @@ -19,30 +19,37 @@ ) (type: #export (Comparison a) + {#.doc (doc "An arbitrary comparison between two values, with the knowledge of how to order them.")} (-> (Order a) a a Bit)) (def: #export (<= order parameter subject) + {#.doc (doc "Less than or equal.")} Comparison (or (\ order < parameter subject) (\ order = parameter subject))) (def: #export (> order parameter subject) + {#.doc (doc "Greater than.")} Comparison (\ order < subject parameter)) (def: #export (>= order parameter subject) + {#.doc (doc "Greater than or equal.")} Comparison (or (\ order < subject parameter) (\ order = subject parameter))) (type: #export (Choice a) + {#.doc (doc "A choice comparison between two values, with the knowledge of how to order them.")} (-> (Order a) a a a)) (def: #export (min order x y) + {#.doc (doc "Minimum.")} Choice (if (\ order < y x) x y)) (def: #export (max order x y) + {#.doc (doc "Maximum.")} Choice (if (\ order < y x) y x)) diff --git a/stdlib/source/library/lux/abstract/predicate.lux b/stdlib/source/library/lux/abstract/predicate.lux index 205ccc316..d53a9a3cb 100644 --- a/stdlib/source/library/lux/abstract/predicate.lux +++ b/stdlib/source/library/lux/abstract/predicate.lux @@ -9,21 +9,29 @@ ["." contravariant]]]) (type: #export (Predicate a) + {#.doc (doc "A question that can be asked of a value, yield either false (#0) or true (#1).")} (-> a Bit)) -(template [<identity_name> <identity_value> <composition_name> <composition>] +(template [<identity_name> <identity_value> <composition_name> <composition> + <identity_doc> <composition_doc>] [(def: #export <identity_name> + {#.doc <identity_doc>} Predicate (function.constant <identity_value>)) (def: #export (<composition_name> left right) + {#.doc <composition_doc>} (All [a] (-> (Predicate a) (Predicate a) (Predicate a))) (function (_ value) (<composition> (left value) (right value))))] - [none #0 unite or] - [all #1 intersect and] + [none #0 unite or + (doc "A predicate that always fails.") + (doc "A predicate that meets either predecessor.")] + [all #1 intersect and + (doc "A predicate that always succeeds.") + (doc "A predicate that meets both predecessors.")] ) (template [<name> <identity> <composition>] @@ -38,16 +46,19 @@ ) (def: #export (complement predicate) + {#.doc (doc "The opposite of a predicate.")} (All [a] (-> (Predicate a) (Predicate a))) (|>> predicate not)) (def: #export (difference sub base) + {#.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))))) (def: #export (rec predicate) + {#.doc (doc "Ties the knot for a recursive predicate.")} (All [a] (-> (-> (Predicate a) (Predicate a)) (Predicate a))) diff --git a/stdlib/source/library/lux/control/concatenative.lux b/stdlib/source/library/lux/control/concatenative.lux index 3ab6c0f05..0d87210c3 100644 --- a/stdlib/source/library/lux/control/concatenative.lux +++ b/stdlib/source/library/lux/control/concatenative.lux @@ -65,8 +65,8 @@ (wrap singleton) _ - (meta.fail (format "Cannot expand to more than a single AST/Code node:" text.new_line - (|> expansion (list\map %.code) (text.join_with " "))))))) + (meta.failure (format "Cannot expand to more than a single AST/Code node:" text.new_line + (|> expansion (list\map %.code) (text.join_with " "))))))) (syntax: #export (=> {aliases aliases^} {inputs stack^} diff --git a/stdlib/source/library/lux/control/concurrency/actor.lux b/stdlib/source/library/lux/control/concurrency/actor.lux index 355a7885e..b2b619735 100644 --- a/stdlib/source/library/lux/control/concurrency/actor.lux +++ b/stdlib/source/library/lux/control/concurrency/actor.lux @@ -1,4 +1,5 @@ -(.module: {#.doc "The actor model of concurrency."} +(.module: + {#.doc "The actor model of concurrency."} [library [lux #* ["." debug] @@ -34,27 +35,27 @@ ["." abstract (#+ abstract: :representation :abstraction)]]]] [// ["." atom (#+ Atom atom)] - ["." promise (#+ Promise Resolver) ("#\." monad)] + ["." async (#+ Async Resolver) ("#\." monad)] ["." frp (#+ Channel)]]) (exception: #export poisoned) (exception: #export dead) (with_expansions - [<Mail> (as_is (-> s (Actor s) (Promise (Try s)))) + [<Mail> (as_is (-> s (Actor s) (Async (Try s)))) <Obituary> (as_is [Text s (List <Mail>)]) <Mailbox> (as_is (Rec Mailbox - [(Promise [<Mail> Mailbox]) + [(Async [<Mail> Mailbox]) (Resolver [<Mail> Mailbox])]))] (def: (pending [read write]) (All [a] (-> (Rec Mailbox - [(Promise [a Mailbox]) + [(Async [a Mailbox]) (Resolver [a Mailbox])]) (IO (List a)))) (do {! io.monad} - [current (promise.poll read)] + [current (async.poll read)] (case current (#.Some [head tail]) (\ ! map (|>> (#.Cons head)) @@ -64,7 +65,7 @@ (wrap #.Nil)))) (abstract: #export (Actor s) - {#obituary [(Promise <Obituary>) + {#obituary [(Async <Obituary>) (Resolver <Obituary>)] #mailbox (Atom <Mailbox>)} @@ -81,7 +82,7 @@ (type: #export (Behavior o s) {#.doc (doc "An actor's behavior when mail is received and when a fatal error occurs.")} {#on_init (-> o s) - #on_mail (-> (Mail s) s (Actor s) (Promise (Try s)))}) + #on_mail (-> (Mail s) s (Actor s) (Async (Try s)))}) (def: #export (spawn! behavior init) {#.doc (doc "Given a behavior and initial state, spawns an actor and returns it.")} @@ -92,11 +93,11 @@ behavior (Actor s) - (:abstraction {#obituary (promise.promise []) - #mailbox (atom (promise.promise []))})) + (:abstraction {#obituary (async.async []) + #mailbox (atom (async.async []))})) process (loop [state (on_init init) [|mailbox| _] (io.run (atom.read (get@ #mailbox (:representation self))))] - (do {! promise.monad} + (do {! async.monad} [[head tail] |mailbox| ?state' (on_mail head state self)] (case ?state' @@ -116,7 +117,7 @@ (All [s] (-> (Actor s) (IO Bit))) (let [[obituary _] (get@ #obituary (:representation actor))] (|> obituary - promise.poll + async.poll (\ io.functor map (|>> (case> #.None bit.yes @@ -127,11 +128,11 @@ (def: #export (obituary actor) (All [s] (-> (Actor s) (IO (Maybe (Obituary s))))) (let [[obituary _] (get@ #obituary (:representation actor))] - (promise.poll obituary))) + (async.poll obituary))) (def: #export await {#.doc (doc "Await for an actor to end working.")} - (All [s] (-> (Actor s) (Promise (Obituary s)))) + (All [s] (-> (Actor s) (Async (Obituary s)))) (|>> :representation (get@ #obituary) product.left)) @@ -142,12 +143,12 @@ (do {! io.monad} [alive? (..alive? actor)] (if alive? - (let [entry [mail (promise.promise [])]] + (let [entry [mail (async.async [])]] (do ! [|mailbox|&resolve (atom.read (get@ #mailbox (:representation actor)))] (loop [[|mailbox| resolve] |mailbox|&resolve] (do ! - [|mailbox| (promise.poll |mailbox|)] + [|mailbox| (async.poll |mailbox|)] (case |mailbox| #.None (do ! @@ -164,39 +165,39 @@ (type: #export (Message s o) {#.doc (doc "A two-way message sent to an actor, expecting a reply.")} - (-> s (Actor s) (Promise (Try [s o])))) + (-> s (Actor s) (Async (Try [s o])))) (def: (mail message) - (All [s o] (-> (Message s o) [(Promise (Try o)) (Mail s)])) - (let [[promise resolve] (:sharing [s o] - (Message s o) - message - - [(Promise (Try o)) - (Resolver (Try o))] - (promise.promise []))] - [promise + (All [s o] (-> (Message s o) [(Async (Try o)) (Mail s)])) + (let [[async resolve] (:sharing [s o] + (Message s o) + message + + [(Async (Try o)) + (Resolver (Try o))] + (async.async []))] + [async (function (_ state self) - (do {! promise.monad} + (do {! async.monad} [outcome (message state self)] (case outcome (#try.Success [state' return]) (exec (io.run (resolve (#try.Success return))) - (promise.resolved (#try.Success state'))) + (async.resolved (#try.Success state'))) (#try.Failure error) (exec (io.run (resolve (#try.Failure error))) - (promise.resolved (#try.Failure error))))))])) + (async.resolved (#try.Failure error))))))])) (def: #export (tell! message actor) {#.doc (doc "Communicate with an actor through message-passing.")} - (All [s o] (-> (Message s o) (Actor s) (Promise (Try o)))) - (let [[promise mail] (..mail message)] - (do promise.monad - [outcome (promise.future (..mail! mail actor))] + (All [s o] (-> (Message s o) (Actor s) (Async (Try o)))) + (let [[async mail] (..mail message)] + (do async.monad + [outcome (async.future (..mail! mail actor))] (case outcome (#try.Success) - promise + async (#try.Failure error) (wrap (#try.Failure error)))))) @@ -204,7 +205,7 @@ ) (def: (default_on_mail mail state self) - (All [s] (-> (Mail s) s (Actor s) (Promise (Try s)))) + (All [s] (-> (Mail s) s (Actor s) (Async (Try s)))) (mail state self)) (def: #export default @@ -218,7 +219,7 @@ "but allows the actor to handle previous mail.")} (All [s] (-> (Actor s) (IO (Try Any)))) (..mail! (function (_ state self) - (promise.resolved (exception.throw ..poisoned []))) + (async.resolved (exception.throw ..poisoned []))) actor)) (def: actor_decl^ @@ -261,7 +262,7 @@ (List a) ((on_mail mail state self) - (do (try.with promise.monad) + (do (try.with async.monad) [#let [_ (debug.log! "BEFORE")] output (mail state self) #let [_ (debug.log! "AFTER")]] @@ -270,7 +271,7 @@ (message: #export (push {value a} state self) (List a) (let [state' (#.Cons value state)] - (promise.resolved (#try.Success [state' state']))))) + (async.resolved (#try.Success [state' state']))))) (actor: #export Counter Nat @@ -278,11 +279,11 @@ (message: #export (count! {increment Nat} state self) Any (let [state' (n.+ increment state)] - (promise.resolved (#try.Success [state' state'])))) + (async.resolved (#try.Success [state' state'])))) (message: #export (read! state self) Nat - (promise.resolved (#try.Success [state state])))))] + (async.resolved (#try.Success [state state])))))] (syntax: #export (actor: {export |export|.parser} {[name vars] actor_decl^} @@ -353,7 +354,7 @@ body) {#.doc (doc "A message can access the actor's state through the state parameter." "A message can also access the actor itself through the self parameter." - "A message's output must be a promise containing a 2-tuple with the updated state and a return value." + "A message's output must be an async containing a 2-tuple with the updated state and a return value." "A message may succeed or fail (in case of failure, the actor dies)." <examples>)} @@ -378,10 +379,10 @@ (let [(~ g!state) (:as (~ (get@ #abstract.representation actor_scope)) (~ g!state))] (|> (~ body) - (: ((~! promise.Promise) ((~! try.Try) [(~ (get@ #abstract.representation actor_scope)) - (~ output_type)]))) - (:as ((~! promise.Promise) ((~! try.Try) [(~ (get@ #abstract.abstraction actor_scope)) - (~ output_type)])))))))) + (: ((~! 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 diff --git a/stdlib/source/library/lux/control/concurrency/promise.lux b/stdlib/source/library/lux/control/concurrency/async.lux index 24618fa5a..875602eff 100644 --- a/stdlib/source/library/lux/control/concurrency/promise.lux +++ b/stdlib/source/library/lux/control/concurrency/async.lux @@ -17,23 +17,23 @@ ["." thread] ["." atom (#+ Atom atom)]]) -(abstract: #export (Promise a) +(abstract: #export (Async a) (Atom [(Maybe a) (List (-> a (IO Any)))]) {#.doc "Represents values produced by asynchronous computations (unlike IO, which is synchronous)."} (type: #export (Resolver a) - {#.doc (doc "The function used to give a value to a promise." - "Will signal 'true' if the promise has been resolved for the 1st time, 'false' otherwise.")} + {#.doc (doc "The function used to give a value to an async." + "Will signal 'true' if the async has been resolved for the 1st time, 'false' otherwise.")} (-> a (IO Bit))) - (def: (resolver promise) - {#.doc "Sets a promise's value if it has not been done yet."} - (All [a] (-> (Promise a) (Resolver a))) + (def: (resolver async) + {#.doc "Sets an async's value if it has not been done yet."} + (All [a] (-> (Async a) (Resolver a))) (function (resolve value) - (let [promise (:representation promise)] + (let [async (:representation async)] (do {! io.monad} - [(^@ old [_value _observers]) (atom.read promise)] + [(^@ old [_value _observers]) (atom.read async)] (case _value (#.Some _) (wrap #0) @@ -41,7 +41,7 @@ #.None (do ! [#let [new [(#.Some value) #.None]] - succeeded? (atom.compare_and_swap old new promise)] + succeeded? (atom.compare_and_swap old new async)] (if succeeded? (do ! [_ (monad.map ! (function (_ f) (f value)) @@ -50,29 +50,29 @@ (resolve value)))))))) (def: #export (resolved value) - {#.doc (doc "Produces a promise that has already been resolved to the given value.")} - (All [a] (-> a (Promise a))) + {#.doc (doc "Produces an async that has already been resolved to the given value.")} + (All [a] (-> a (Async a))) (:abstraction (atom [(#.Some value) (list)]))) - (def: #export (promise _) - {#.doc (doc "Creates a fresh promise that has not been resolved yet.")} - (All [a] (-> Any [(Promise a) (Resolver a)])) - (let [promise (:abstraction (atom [#.None (list)]))] - [promise (..resolver promise)])) + (def: #export (async _) + {#.doc (doc "Creates a fresh async that has not been resolved yet.")} + (All [a] (-> Any [(Async a) (Resolver a)])) + (let [async (:abstraction (atom [#.None (list)]))] + [async (..resolver async)])) (def: #export poll - {#.doc "Polls a promise for its value."} - (All [a] (-> (Promise a) (IO (Maybe a)))) + {#.doc "Polls an async for its value."} + (All [a] (-> (Async a) (IO (Maybe a)))) (|>> :representation atom.read (\ io.functor map product.left))) - (def: #export (await f promise) - {#.doc (doc "Executes the given function as soon as the promise has been resolved.")} - (All [a] (-> (-> a (IO Any)) (Promise a) (IO Any))) + (def: #export (await f async) + {#.doc (doc "Executes the given function as soon as the async has been resolved.")} + (All [a] (-> (-> a (IO Any)) (Async a) (IO Any))) (do {! io.monad} - [#let [promise (:representation promise)] - (^@ old [_value _observers]) (atom.read promise)] + [#let [async (:representation async)] + (^@ old [_value _observers]) (atom.read async)] (case _value (#.Some value) (f value) @@ -80,15 +80,15 @@ #.None (let [new [_value (#.Cons f _observers)]] (do ! - [swapped? (atom.compare_and_swap old new promise)] + [swapped? (atom.compare_and_swap old new async)] (if swapped? (wrap []) - (await f (:abstraction promise)))))))) + (await f (:abstraction async)))))))) ) (def: #export resolved? - {#.doc "Checks whether a promise's value has already been resolved."} - (All [a] (-> (Promise a) (IO Bit))) + {#.doc "Checks whether an async's value has already been resolved."} + (All [a] (-> (Async a) (IO Bit))) (|>> ..poll (\ io.functor map (|>> (case> #.None @@ -98,47 +98,47 @@ #1))))) (implementation: #export functor - (Functor Promise) + (Functor Async) (def: (map f fa) - (let [[fb resolve] (..promise [])] + (let [[fb resolve] (..async [])] (exec (io.run (..await (|>> f resolve) fa)) fb)))) (implementation: #export apply - (Apply Promise) + (Apply Async) (def: &functor ..functor) (def: (apply ff fa) - (let [[fb resolve] (..promise [])] + (let [[fb resolve] (..async [])] (exec (io.run (..await (function (_ f) (..await (|>> f resolve) fa)) ff)) fb)))) (implementation: #export monad - (Monad Promise) + (Monad Async) (def: &functor ..functor) (def: wrap ..resolved) (def: (join mma) - (let [[ma resolve] (promise [])] + (let [[ma resolve] (async [])] (exec (io.run (..await (..await resolve) mma)) ma)))) (def: #export (and left right) - {#.doc (doc "Combines the results of both promises, in-order.")} - (All [a b] (-> (Promise a) (Promise b) (Promise [a b]))) + {#.doc (doc "Combines the results of both asyncs, in-order.")} + (All [a b] (-> (Async a) (Async b) (Async [a b]))) (let [[read! write!] (:sharing [a b] - [(Promise a) (Promise b)] + [(Async a) (Async b)] [left right] - [(Promise [a b]) + [(Async [a b]) (Resolver [a b])] - (..promise [])) + (..async [])) _ (io.run (..await (function (_ left) (..await (function (_ right) (write! [left right])) @@ -147,13 +147,13 @@ read!)) (def: #export (or left right) - {#.doc (doc "Yields the results of whichever promise gets resolved first." + {#.doc (doc "Yields the results of whichever async gets resolved first." "You can tell which one was resolved first through pattern-matching.")} - (All [a b] (-> (Promise a) (Promise b) (Promise (| a b)))) - (let [[a|b resolve] (..promise [])] + (All [a b] (-> (Async a) (Async b) (Async (| a b)))) + (let [[a|b resolve] (..async [])] (with_expansions - [<sides> (template [<promise> <tag>] - [(io.run (await (|>> <tag> resolve) <promise>))] + [<sides> (template [<async> <tag>] + [(io.run (await (|>> <tag> resolve) <async>))] [left #.Left] [right #.Right] @@ -162,12 +162,12 @@ a|b)))) (def: #export (either left right) - {#.doc (doc "Yields the results of whichever promise gets resolved first." + {#.doc (doc "Yields the results of whichever async gets resolved first." "You cannot tell which one was resolved first.")} - (All [a] (-> (Promise a) (Promise a) (Promise a))) - (let [[left||right resolve] (..promise [])] - (`` (exec (~~ (template [<promise>] - [(io.run (await resolve <promise>))] + (All [a] (-> (Async a) (Async a) (Async a))) + (let [[left||right resolve] (..async [])] + (`` (exec (~~ (template [<async>] + [(io.run (await resolve <async>))] [left] [right])) @@ -176,8 +176,8 @@ (def: #export (schedule millis_delay computation) {#.doc (doc "Runs an I/O computation on its own thread (after a specified delay)." "Returns a aromise that will eventually host its result.")} - (All [a] (-> Nat (IO a) (Promise a))) - (let [[!out resolve] (..promise [])] + (All [a] (-> Nat (IO a) (Async a))) + (let [[!out resolve] (..async [])] (exec (|> (do io.monad [value computation] (resolve value)) @@ -187,21 +187,21 @@ (def: #export future {#.doc (doc "Runs an I/O computation on its own thread." - "Returns a promise that will eventually host its result.")} - (All [a] (-> (IO a) (Promise a))) + "Returns an async that will eventually host its result.")} + (All [a] (-> (IO a) (Async a))) (..schedule 0)) (def: #export (delay time_millis value) {#.doc "Delivers a value after a certain period has passed."} - (All [a] (-> Nat a (Promise a))) + (All [a] (-> Nat a (Async a))) (..schedule time_millis (io value))) (def: #export (wait time_millis) - {#.doc "Returns a promise that will be resolved after the specified amount of milliseconds."} - (-> Nat (Promise Any)) + {#.doc "Returns an async that will be resolved after the specified amount of milliseconds."} + (-> Nat (Async Any)) (..delay time_millis [])) -(def: #export (time_out time_millis promise) - {#.doc "Wait for a promise to be resolved within the specified amount of milliseconds."} - (All [a] (-> Nat (Promise a) (Promise (Maybe a)))) - (..or (wait time_millis) promise)) +(def: #export (time_out time_millis async) + {#.doc "Wait for an async to be resolved within the specified amount of milliseconds."} + (All [a] (-> Nat (Async a) (Async (Maybe a)))) + (..or (wait time_millis) async)) diff --git a/stdlib/source/library/lux/control/concurrency/frp.lux b/stdlib/source/library/lux/control/concurrency/frp.lux index f69a88369..fee1a5dda 100644 --- a/stdlib/source/library/lux/control/concurrency/frp.lux +++ b/stdlib/source/library/lux/control/concurrency/frp.lux @@ -16,11 +16,11 @@ abstract]]] [// ["." atom (#+ Atom)] - ["." promise (#+ Promise) ("#\." functor)]]) + ["." async (#+ Async) ("#\." functor)]]) (type: #export (Channel a) {#.doc "An asynchronous channel to distribute values."} - (Promise (Maybe [a (Channel a)]))) + (Async (Maybe [a (Channel a)]))) (exception: #export channel_is_already_closed) @@ -33,7 +33,7 @@ (def: (sink resolve) (All [a] - (-> (promise.Resolver (Maybe [a (Channel a)])) + (-> (async.Resolver (Maybe [a (Channel a)])) (Sink a))) (let [sink (atom.atom resolve)] (implementation @@ -59,12 +59,12 @@ (do {! io.monad} [current (atom.read sink) #let [[next resolve_next] (:sharing [a] - (promise.Resolver (Maybe [a (Channel a)])) + (async.Resolver (Maybe [a (Channel a)])) current - [(Promise (Maybe [a (Channel a)])) - (promise.Resolver (Maybe [a (Channel a)]))] - (promise.promise []))] + [(Async (Maybe [a (Channel a)])) + (async.Resolver (Maybe [a (Channel a)]))] + (async.async []))] fed? (current (#.Some [value next]))] (if fed? ## I fed the sink. @@ -83,14 +83,14 @@ (def: #export (channel _) {#.doc (doc "Creates a brand-new channel and hands it over, along with the sink to write to it.")} (All [a] (-> Any [(Channel a) (Sink a)])) - (let [[promise resolve] (promise.promise [])] - [promise (..sink resolve)])) + (let [[async resolve] (async.async [])] + [async (..sink resolve)])) (implementation: #export functor (Functor Channel) (def: (map f) - (promise\map + (async\map (maybe\map (function (_ [head tail]) [(f head) (map f tail)]))))) @@ -101,7 +101,7 @@ (def: &functor ..functor) (def: (apply ff fa) - (do promise.monad + (do async.monad [cons_f ff cons_a fa] (case [cons_f cons_a] @@ -113,7 +113,7 @@ (def: empty Channel - (promise.resolved #.None)) + (async.resolved #.None)) (implementation: #export monad (Monad Channel) @@ -121,13 +121,13 @@ (def: &functor ..functor) (def: (wrap a) - (promise.resolved (#.Some [a ..empty]))) + (async.resolved (#.Some [a ..empty]))) (def: (join mma) (let [[output sink] (channel [])] - (exec (: (Promise Any) + (exec (: (Async Any) (loop [mma mma] - (do {! promise.monad} + (do {! async.monad} [?mma mma] (case ?mma (#.Some [ma mma']) @@ -154,9 +154,9 @@ (def: #export (subscribe subscriber channel) (All [a] (-> (Subscriber a) (Channel a) (IO Any))) - (io (exec (: (Promise Any) + (io (exec (: (Async Any) (loop [channel channel] - (do promise.monad + (do async.monad [cons channel] (case cons (#.Some [head tail]) @@ -175,7 +175,7 @@ {#.doc (doc "Produces a new channel based on the old one, only with values" "that pass the test.")} (All [a] (-> (-> a Bit) (Channel a) (Channel a))) - (do promise.monad + (do async.monad [cons channel] (case cons (#.Some [head tail]) @@ -187,19 +187,19 @@ #.None (wrap #.None)))) -(def: #export (of_promise promise) - {#.doc (doc "A one-element channel containing the output from a promise.")} - (All [a] (-> (Promise a) (Channel a))) - (promise\map (function (_ value) - (#.Some [value ..empty])) - promise)) +(def: #export (of_async async) + {#.doc (doc "A one-element channel containing the output from an async.")} + (All [a] (-> (Async a) (Channel a))) + (async\map (function (_ value) + (#.Some [value ..empty])) + async)) (def: #export (fold f init channel) {#.doc "Asynchronous fold over channels."} (All [a b] - (-> (-> b a (Promise a)) a (Channel b) - (Promise a))) - (do {! promise.monad} + (-> (-> b a (Async a)) a (Channel b) + (Async a))) + (do {! async.monad} [cons channel] (case cons #.None @@ -212,9 +212,9 @@ (def: #export (folds f init channel) (All [a b] - (-> (-> b a (Promise a)) a (Channel b) + (-> (-> b a (Async a)) a (Channel b) (Channel a))) - (do {! promise.monad} + (do {! async.monad} [cons channel] (case cons #.None @@ -233,7 +233,7 @@ (do io.monad [value action _ (\ sink feed value)] - (promise.await recur (promise.wait milli_seconds))))) + (async.await recur (async.wait milli_seconds))))) [output sink]))) (def: #export (periodic milli_seconds) @@ -241,8 +241,8 @@ (..poll milli_seconds (io []))) (def: #export (iterate f init) - (All [s o] (-> (-> s (Promise (Maybe [s o]))) s (Channel o))) - (do promise.monad + (All [s o] (-> (-> s (Async (Maybe [s o]))) s (Channel o))) + (do async.monad [?next (f init)] (case ?next (#.Some [state output]) @@ -253,7 +253,7 @@ (def: (distinct' equivalence previous channel) (All [a] (-> (Equivalence a) a (Channel a) (Channel a))) - (do promise.monad + (do async.monad [cons channel] (case cons (#.Some [head tail]) @@ -266,7 +266,7 @@ (def: #export (distinct equivalence channel) (All [a] (-> (Equivalence a) (Channel a) (Channel a))) - (do promise.monad + (do async.monad [cons channel] (case cons (#.Some [head tail]) @@ -276,8 +276,8 @@ (wrap #.None)))) (def: #export (consume channel) - (All [a] (-> (Channel a) (Promise (List a)))) - (do {! promise.monad} + (All [a] (-> (Channel a) (Async (List a)))) + (do {! async.monad} [cons channel] (case cons (#.Some [head tail]) @@ -295,6 +295,6 @@ ..empty (#.Cons head tail) - (promise.resolved (#.Some [head (do promise.monad - [_ (promise.wait milli_seconds)] - (sequential milli_seconds tail))])))) + (async.resolved (#.Some [head (do async.monad + [_ (async.wait milli_seconds)] + (sequential milli_seconds tail))])))) diff --git a/stdlib/source/library/lux/control/concurrency/semaphore.lux b/stdlib/source/library/lux/control/concurrency/semaphore.lux index 821250fb3..56b70bbc1 100644 --- a/stdlib/source/library/lux/control/concurrency/semaphore.lux +++ b/stdlib/source/library/lux/control/concurrency/semaphore.lux @@ -22,7 +22,7 @@ ["." refinement]]]] [// ["." atom (#+ Atom)] - ["." promise (#+ Promise Resolver)]]) + ["." async (#+ Async Resolver)]]) (type: State {#max_positions Nat @@ -48,10 +48,10 @@ (def: #export (wait semaphore) {#.doc (doc "Wait on a semaphore until there are open positions." "After finishing your work, you must 'signal' to the semaphore that you're done.")} - (Ex [k] (-> Semaphore (Promise Any))) + (Ex [k] (-> Semaphore (Async Any))) (let [semaphore (:representation semaphore) - [signal sink] (: [(Promise Any) (Resolver Any)] - (promise.promise []))] + [signal sink] (: [(Async Any) (Resolver Any)] + (async.async []))] (exec (io.run (with_expansions [<had_open_position?> (as_is (get@ #open_positions) (i.> -1))] (do io.monad @@ -73,9 +73,9 @@ (def: #export (signal semaphore) {#.doc (doc "Signal to a semaphore that you're done with your work, and that there is a new open position.")} - (Ex [k] (-> Semaphore (Promise (Try Int)))) + (Ex [k] (-> Semaphore (Async (Try Int)))) (let [semaphore (:representation semaphore)] - (promise.future + (async.future (do {! io.monad} [[pre post] (atom.update (function (_ state) (if (i.= (.int (get@ #max_positions state)) @@ -108,17 +108,17 @@ (:abstraction (semaphore 1))) (def: acquire - (-> Mutex (Promise Any)) + (-> Mutex (Async Any)) (|>> :representation ..wait)) (def: release - (-> Mutex (Promise Any)) + (-> Mutex (Async Any)) (|>> :representation ..signal)) (def: #export (synchronize mutex procedure) {#.doc (doc "Runs the procedure with exclusive control of the mutex.")} - (All [a] (-> Mutex (IO (Promise a)) (Promise a))) - (do promise.monad + (All [a] (-> Mutex (IO (Async a)) (Async a))) + (do async.monad [_ (..acquire mutex) output (io.run procedure) _ (..release mutex)] @@ -149,18 +149,18 @@ #end_turnstile (..semaphore 0)})) (def: (un_block times turnstile) - (-> Nat Semaphore (Promise Any)) + (-> Nat Semaphore (Async Any)) (loop [step 0] (if (n.< times step) - (do promise.monad + (do async.monad [outcome (..signal turnstile)] (recur (inc step))) - (\ promise.monad wrap [])))) + (\ async.monad wrap [])))) (template [<phase> <update> <goal> <turnstile>] [(def: (<phase> (^:representation barrier)) - (-> Barrier (Promise Any)) - (do promise.monad + (-> Barrier (Async Any)) + (do async.monad [#let [limit (refinement.un_refine (get@ #limit barrier)) goal <goal> [_ count] (io.run (atom.update <update> (get@ #count barrier))) @@ -175,8 +175,8 @@ (def: #export (block barrier) {#.doc (doc "Wait on a barrier until all processes have arrived and met the barrier's limit.")} - (-> Barrier (Promise Any)) - (do promise.monad + (-> Barrier (Async Any)) + (do async.monad [_ (..start barrier)] (..end barrier))) ) diff --git a/stdlib/source/library/lux/control/concurrency/stm.lux b/stdlib/source/library/lux/control/concurrency/stm.lux index 833dff059..3f912c3de 100644 --- a/stdlib/source/library/lux/control/concurrency/stm.lux +++ b/stdlib/source/library/lux/control/concurrency/stm.lux @@ -17,7 +17,7 @@ abstract]]] [// ["." atom (#+ Atom atom)] - ["." promise (#+ Promise Resolver)] + ["." async (#+ Async Resolver)] ["." frp (#+ Channel Sink)]]) (type: (Observer a) @@ -200,14 +200,14 @@ (type: (Commit a) [(STM a) - (Promise a) + (Async a) (Resolver a)]) (def: pending_commits (Atom (Rec Commits - [(Promise [(Ex [a] (Commit a)) Commits]) + [(Async [(Ex [a] (Commit a)) Commits]) (Resolver [(Ex [a] (Commit a)) Commits])])) - (atom (promise.promise []))) + (atom (async.async []))) (def: commit_processor_flag (Atom Bit) @@ -215,12 +215,12 @@ (def: (issue_commit commit) (All [a] (-> (Commit a) (IO Any))) - (let [entry [commit (promise.promise [])]] + (let [entry [commit (async.async [])]] (do {! io.monad} [|commits|&resolve (atom.read pending_commits)] (loop [[|commits| resolve] |commits|&resolve] (do ! - [|commits| (promise.poll |commits|)] + [|commits| (async.poll |commits|)] (case |commits| #.None (do io.monad @@ -252,12 +252,12 @@ [was_first? (atom.compare_and_swap flag #1 commit_processor_flag)] (if was_first? (do ! - [[promise resolve] (atom.read pending_commits)] - (promise.await (function (recur [head [tail _resolve]]) - (do ! - [_ (process_commit head)] - (promise.await recur tail))) - promise)) + [[async resolve] (atom.read pending_commits)] + (async.await (function (recur [head [tail _resolve]]) + (do ! + [_ (process_commit head)] + (async.await recur tail))) + async)) (wrap []))) ))) @@ -265,8 +265,8 @@ {#.doc (doc "Commits a transaction and returns its result (asynchronously)." "Note that a transaction may be re-run an indeterminate number of times if other transactions involving the same variables successfully commit first." "For this reason, it's important to note that transactions must be free from side-effects, such as I/O.")} - (All [a] (-> (STM a) (Promise a))) - (let [[output resolver] (promise.promise [])] + (All [a] (-> (STM a) (Async a))) + (let [[output resolver] (async.async [])] (exec (io.run (do io.monad [_ init_processor!] (issue_commit [stm_proc output resolver]))) diff --git a/stdlib/source/library/lux/control/function/mutual.lux b/stdlib/source/library/lux/control/function/mutual.lux index 4ceaaa61f..97d2c3ac1 100644 --- a/stdlib/source/library/lux/control/function/mutual.lux +++ b/stdlib/source/library/lux/control/function/mutual.lux @@ -87,8 +87,8 @@ hidden_names (monad.map ! (//.constant (macro.gensym "mutual_function#")) functions) #let [definitions (list\map (..mutual_definition hidden_names g!context) - (list.zip/2 hidden_names - functions)) + (list.zipped/2 hidden_names + functions)) context_types (list\map (function (_ mutual) (` (-> (~ g!context) (~ (get@ #type mutual))))) functions) @@ -97,8 +97,8 @@ g!pop (local.push (list\map (function (_ [g!name mutual]) [[here_name (get@ [#declaration #declaration.name] mutual)] (..macro g!context g!name)]) - (list.zip/2 hidden_names - functions)))] + (list.zipped/2 hidden_names + functions)))] (wrap (list (` (.let [(~ g!context) (: (Rec (~ g!context) [(~+ context_types)]) [(~+ definitions)]) @@ -153,8 +153,8 @@ hidden_names (monad.map ! (//.constant (macro.gensym "mutual_function#")) functions) #let [definitions (list\map (..mutual_definition hidden_names g!context) - (list.zip/2 hidden_names - (list\map (get@ #mutual) functions))) + (list.zipped/2 hidden_names + (list\map (get@ #mutual) functions))) context_types (list\map (function (_ mutual) (` (-> (~ g!context) (~ (get@ [#mutual #type] mutual))))) functions) @@ -163,8 +163,8 @@ g!pop (local.push (list\map (function (_ [g!name mutual]) [[here_name (get@ [#mutual #declaration #declaration.name] mutual)] (..macro g!context g!name)]) - (list.zip/2 hidden_names - functions)))] + (list.zipped/2 hidden_names + functions)))] (wrap (list& (` (.def: (~ g!context) [(~+ (list\map (get@ [#mutual #type]) functions))] (.let [(~ g!context) (: (Rec (~ g!context) diff --git a/stdlib/source/library/lux/control/parser.lux b/stdlib/source/library/lux/control/parser.lux index 3dc90e1d2..d017e9dd4 100644 --- a/stdlib/source/library/lux/control/parser.lux +++ b/stdlib/source/library/lux/control/parser.lux @@ -221,7 +221,7 @@ _ (#try.Failure "Expected to fail; yet succeeded.")))) -(def: #export (fail message) +(def: #export (failure message) (All [s a] (-> Text (Parser s a))) (function (_ input) (#try.Failure message))) diff --git a/stdlib/source/library/lux/control/parser/analysis.lux b/stdlib/source/library/lux/control/parser/analysis.lux index cdfb18504..df8d140ab 100644 --- a/stdlib/source/library/lux/control/parser/analysis.lux +++ b/stdlib/source/library/lux/control/parser/analysis.lux @@ -13,6 +13,8 @@ ["%" format (#+ format)]] [collection ["." list ("#\." functor)]]] + [macro + ["." template]] [math [number ["." i64] @@ -47,9 +49,11 @@ ["Input" (exception.enumerate /.%analysis input)])) (type: #export Parser + {#.doc (doc "A parser for Lux code analysis nodes.")} (//.Parser (List Analysis))) (def: #export (run parser input) + {#.doc (doc "Executes a parser and makes sure no inputs go unconsumed.")} (All [a] (-> (Parser a) (List Analysis) (Try a))) (case (parser input) (#try.Failure error) @@ -62,6 +66,7 @@ (exception.throw ..unconsumed_input unconsumed))) (def: #export any + {#.doc (doc "Matches any value, without discrimination.")} (Parser Analysis) (function (_ input) (case input @@ -89,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))))] + [(`` (as_is (def: #export <query> + {#.doc (doc (~~ (template.text ["Queries for a " <query> " value."])))} + (Parser <type>) + (function (_ input) + (case input + (^ (list& (<tag> x) input')) + (#try.Success [input' x]) + + _ + (exception.throw ..cannot_parse input)))) + + (def: #export (<assertion> expected) + {#.doc (doc (~~ (template.text ["Assert a specific " <query> " value."])))} + (-> <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))))))] [bit bit! /.bit Bit bit.equivalence] [nat nat! /.nat Nat nat.equivalence] @@ -123,6 +130,7 @@ ) (def: #export (tuple parser) + {#.doc (doc "Parses only within the context of a tuple's contents.")} (All [a] (-> (Parser a) (Parser a))) (function (_ input) (case input diff --git a/stdlib/source/library/lux/control/parser/binary.lux b/stdlib/source/library/lux/control/parser/binary.lux index ec06bec54..f7a2cb94a 100644 --- a/stdlib/source/library/lux/control/parser/binary.lux +++ b/stdlib/source/library/lux/control/parser/binary.lux @@ -26,9 +26,12 @@ ["." frac]]]]] ["." // ("#\." monad)]) -(type: #export Offset Nat) +(type: #export Offset + {#.doc (doc "An offset for reading within binary data.")} + Nat) (type: #export Parser + {#.doc (doc "A parser for raw binary data.")} (//.Parser [Offset Binary])) (exception: #export (binary_was_not_fully_read {binary_length Nat} {bytes_read Nat}) @@ -37,6 +40,7 @@ ["Bytes read" (%.nat bytes_read)])) (def: #export (run parser input) + {#.doc (doc "Runs a parser and checks that all the binary data was read by it.")} (All [a] (-> (Parser a) Binary (Try a))) (case (parser [0 input]) (#try.Failure msg) @@ -49,21 +53,26 @@ (exception.throw ..binary_was_not_fully_read [length end]))))) (def: #export end? + {#.doc (doc "Checks whether there is no more data to read.")} (Parser Bit) (function (_ (^@ input [offset data])) (#try.Success [input (n.= offset (/.size data))]))) (def: #export offset + {#.doc (doc "The current offset (i.e. how much data has been read).")} (Parser Offset) (function (_ (^@ input [offset data])) (#try.Success [input offset]))) (def: #export remaining + {#.doc (doc "How much of the data remains to be read.")} (Parser Nat) (function (_ (^@ input [offset data])) (#try.Success [input (n.- offset (/.size data))]))) -(type: #export Size Nat) +(type: #export Size + {#.doc (doc "The size of a chunk of data within a binary array.")} + Nat) (def: #export size/8 Size 1) (def: #export size/16 Size (n.* 2 size/8)) @@ -120,12 +129,14 @@ [1 #.Right right]])) (def: #export (rec body) + {#.doc (doc "Tie the knot for a recursive parser.")} (All [a] (-> (-> (Parser a) (Parser a)) (Parser a))) (function (_ input) (let [parser (body (rec body))] (parser input)))) (def: #export any + {#.doc (doc "Does no parsing, and just returns a dummy value.")} (Parser Any) (//\wrap [])) @@ -145,6 +156,7 @@ _ (//.lift (exception.throw ..not_a_bit [value]))))) (def: #export (segment size) + {#.doc (doc "Parses a chunk of data of a given size.")} (-> Nat (Parser Binary)) (function (_ [offset binary]) (case size @@ -153,36 +165,39 @@ (/.slice offset size) (\ try.monad map (|>> [[(n.+ size offset) binary]])))))) -(template [<name> <bits>] - [(def: #export <name> - (Parser Binary) - (do //.monad - [size (//\map .nat <bits>)] - (..segment size)))] - - [binary/8 ..bits/8] - [binary/16 ..bits/16] - [binary/32 ..bits/32] - [binary/64 ..bits/64] +(template [<size> <name> <bits>] + [(`` (def: #export <name> + {#.doc (doc (~~ (template.text ["Parses a block of data prefixed with a size that is " <size> " bytes long."])))} + (Parser Binary) + (do //.monad + [size (//\map .nat <bits>)] + (..segment size))))] + + [08 binary/8 ..bits/8] + [16 binary/16 ..bits/16] + [32 binary/32 ..bits/32] + [64 binary/64 ..bits/64] ) -(template [<name> <binary>] - [(def: #export <name> - (Parser Text) - (do //.monad - [utf8 <binary>] - (//.lift (\ utf8.codec decode utf8))))] - - [utf8/8 ..binary/8] - [utf8/16 ..binary/16] - [utf8/32 ..binary/32] - [utf8/64 ..binary/64] +(template [<size> <name> <binary>] + [(`` (def: #export <name> + {#.doc (doc (~~ (template.text ["Parses a block of (UTF-8 encoded) text prefixed with a size that is " <size> " bytes long."])))} + (Parser Text) + (do //.monad + [utf8 <binary>] + (//.lift (\ utf8.codec decode utf8)))))] + + [08 utf8/8 ..binary/8] + [16 utf8/16 ..binary/16] + [32 utf8/32 ..binary/32] + [64 utf8/64 ..binary/64] ) (def: #export text ..utf8/64) -(template [<name> <bits>] +(template [<size> <name> <bits>] [(def: #export (<name> valueP) + {#.doc (doc (~~ (template.text ["Parses a row of values prefixed with a size that is " <size> " bytes long."])))} (All [v] (-> (Parser v) (Parser (Row v)))) (do //.monad [amount (: (Parser Nat) @@ -201,10 +216,10 @@ (row.add value output))) (//\wrap output)))))] - [row/8 ..bits/8] - [row/16 ..bits/16] - [row/32 ..bits/32] - [row/64 ..bits/64] + [08 row/8 ..bits/8] + [16 row/16 ..bits/16] + [32 row/32 ..bits/32] + [64 row/64 ..bits/64] ) (def: #export maybe @@ -212,6 +227,7 @@ (..or ..any)) (def: #export (list value) + {#.doc (doc "Parses an arbitrarily long list of values.")} (All [a] (-> (Parser a) (Parser (List a)))) (..rec (|>> (//.and value) diff --git a/stdlib/source/library/lux/control/parser/cli.lux b/stdlib/source/library/lux/control/parser/cli.lux index 7cacdd086..5a66208b4 100644 --- a/stdlib/source/library/lux/control/parser/cli.lux +++ b/stdlib/source/library/lux/control/parser/cli.lux @@ -15,6 +15,7 @@ (//.Parser (List Text) a)) (def: #export (run parser inputs) + {#.doc (doc "Executes the parser and verifies that all inputs are processed.")} (All [a] (-> (Parser a) (List Text) (Try a))) (case (//.run parser inputs) (#try.Success [remaining output]) @@ -87,12 +88,14 @@ _ (#try.Failure (format "Unknown parameters: " (text.join_with " " inputs)))))) (def: #export (named name value) + {#.doc (doc "Parses a named parameter and yields its value.")} (All [a] (-> Text (Parser a) (Parser a))) (|> value (//.after (..this name)) ..somewhere)) (def: #export (parameter [short long] value) + {#.doc (doc "Parses a parameter that can have either a short or a long name.")} (All [a] (-> [Text Text] (Parser a) (Parser a))) (|> value (//.after (//.either (..this short) (..this long))) diff --git a/stdlib/source/library/lux/control/parser/json.lux b/stdlib/source/library/lux/control/parser/json.lux index 0c53041b9..2e9935480 100644 --- a/stdlib/source/library/lux/control/parser/json.lux +++ b/stdlib/source/library/lux/control/parser/json.lux @@ -72,7 +72,7 @@ (wrap value) _ - (//.fail (exception.construct ..unexpected_value [head])))))] + (//.failure (exception.construct ..unexpected_value [head])))))] [null /.Null #/.Null "null"] [boolean /.Boolean #/.Boolean "boolean"] @@ -96,7 +96,7 @@ (wrap (\ <equivalence> = test value)) _ - (//.fail (exception.construct ..unexpected_value [head]))))) + (//.failure (exception.construct ..unexpected_value [head]))))) (def: #export (<check> test) {#.doc (code.text ($_ text\compose "Ensures a JSON value is a " <desc> "."))} @@ -107,10 +107,10 @@ (<tag> value) (if (\ <equivalence> = test value) (wrap []) - (//.fail (exception.construct ..value_mismatch [(<tag> test) (<tag> value)]))) + (//.failure (exception.construct ..value_mismatch [(<tag> test) (<tag> value)]))) _ - (//.fail (exception.construct ..unexpected_value [head])))))] + (//.failure (exception.construct ..unexpected_value [head])))))] [boolean? boolean! /.Boolean bit.equivalence #/.Boolean "boolean"] [number? number! /.Number frac.equivalence #/.Number "number"] @@ -131,7 +131,7 @@ (#/.Array values) (case (//.run parser (row.to_list values)) (#try.Failure error) - (//.fail error) + (//.failure error) (#try.Success [remainder output]) (case remainder @@ -139,10 +139,10 @@ (wrap output) _ - (//.fail (exception.construct ..unconsumed_input remainder)))) + (//.failure (exception.construct ..unconsumed_input remainder)))) _ - (//.fail (exception.construct ..unexpected_value [head]))))) + (//.failure (exception.construct ..unexpected_value [head]))))) (def: #export (object parser) {#.doc "Parses a JSON object. Use this with the 'field' combinator."} @@ -158,7 +158,7 @@ list.concat (//.run parser)) (#try.Failure error) - (//.fail error) + (//.failure error) (#try.Success [remainder output]) (case remainder @@ -166,10 +166,10 @@ (wrap output) _ - (//.fail (exception.construct ..unconsumed_input remainder)))) + (//.failure (exception.construct ..unconsumed_input remainder)))) _ - (//.fail (exception.construct ..unexpected_value [head]))))) + (//.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."} diff --git a/stdlib/source/library/lux/control/parser/type.lux b/stdlib/source/library/lux/control/parser/type.lux index 73a4a9e4e..d76254fe8 100644 --- a/stdlib/source/library/lux/control/parser/type.lux +++ b/stdlib/source/library/lux/control/parser/type.lux @@ -156,7 +156,7 @@ (let [members (<flattener> (type.anonymous headT))] (if (n.> 1 (list.size members)) (local members poly) - (//.fail (exception.construct <exception> headT))))))] + (//.failure (exception.construct <exception> headT))))))] [variant type.flat_variant #.Sum ..not_variant] [tuple type.flat_tuple #.Product ..not_tuple] @@ -168,7 +168,7 @@ [headT any #let [[num_arg bodyT] (type.flat_univ_q (type.anonymous headT))]] (if (n.= 0 num_arg) - (//.fail (exception.construct ..not_polymorphic headT)) + (//.failure (exception.construct ..not_polymorphic headT)) (wrap [num_arg bodyT])))) (def: #export (polymorphic poly) @@ -216,7 +216,7 @@ (if (n.> 0 (list.size inputsT)) (//.and (local inputsT in_poly) (local (list outputT) out_poly)) - (//.fail (exception.construct ..not_function headT))))) + (//.failure (exception.construct ..not_function headT))))) (def: #export (applied poly) (All [a] (-> (Parser a) (Parser a))) @@ -224,7 +224,7 @@ [headT any #let [[funcT paramsT] (type.flat_application (type.anonymous headT))]] (if (n.= 0 (list.size paramsT)) - (//.fail (exception.construct ..not_application headT)) + (//.failure (exception.construct ..not_application headT)) (..local (#.Cons funcT paramsT) poly)))) (template [<name> <test>] @@ -234,7 +234,7 @@ [actual any] (if (<test> expected actual) (wrap []) - (//.fail (exception.construct ..types_do_not_match [expected actual])))))] + (//.failure (exception.construct ..types_do_not_match [expected actual])))))] [exactly type\=] [sub check.checks?] @@ -260,10 +260,10 @@ (wrap poly_code) #.None - (//.fail (exception.construct ..unknown_parameter headT))) + (//.failure (exception.construct ..unknown_parameter headT))) _ - (//.fail (exception.construct ..not_parameter headT))))) + (//.failure (exception.construct ..not_parameter headT))))) (def: #export (parameter! id) (-> Nat (Parser Any)) @@ -274,10 +274,10 @@ (#.Parameter idx) (if (n.= id (adjusted_idx env idx)) (wrap []) - (//.fail (exception.construct ..wrong_parameter [(#.Parameter id) headT]))) + (//.failure (exception.construct ..wrong_parameter [(#.Parameter id) headT]))) _ - (//.fail (exception.construct ..not_parameter headT))))) + (//.failure (exception.construct ..not_parameter headT))))) (def: #export existential (Parser Nat) @@ -288,7 +288,7 @@ (wrap ex_id) _ - (//.fail (exception.construct ..not_existential headT))))) + (//.failure (exception.construct ..not_existential headT))))) (def: #export named (Parser [Name Type]) @@ -299,7 +299,7 @@ (wrap [name anonymousT]) _ - (//.fail (exception.construct ..not_named inputT))))) + (//.failure (exception.construct ..not_named inputT))))) (`` (template: (|nothing|) (#.Named [(~~ (static .prelude_module)) "Nothing"] @@ -320,7 +320,7 @@ (wrap [recT output])) _ - (//.fail (exception.construct ..not_recursive headT))))) + (//.failure (exception.construct ..not_recursive headT))))) (def: #export recursive_self (Parser Code) @@ -334,7 +334,7 @@ (wrap self_call) _ - (//.fail (exception.construct ..not_recursive headT))))) + (//.failure (exception.construct ..not_recursive headT))))) (def: #export recursive_call (Parser Code) diff --git a/stdlib/source/library/lux/control/region.lux b/stdlib/source/library/lux/control/region.lux index ff6247418..83a0fe84d 100644 --- a/stdlib/source/library/lux/control/region.lux +++ b/stdlib/source/library/lux/control/region.lux @@ -135,7 +135,7 @@ (#try.Failure error) (wrap [cleaners (#try.Failure error)])))))) -(def: #export (fail monad error) +(def: #export (failure monad error) (All [! a] (-> (Monad !) Text (All [r] (Region r ! a)))) @@ -146,7 +146,7 @@ (All [! e a] (-> (Monad !) (Exception e) e (All [r] (Region r ! a)))) - (fail monad (exception.construct exception message))) + (failure monad (exception.construct exception message))) (def: #export (lift monad operation) (All [! a] diff --git a/stdlib/source/library/lux/control/remember.lux b/stdlib/source/library/lux/control/remember.lux index f004f109e..c2cc446ed 100644 --- a/stdlib/source/library/lux/control/remember.lux +++ b/stdlib/source/library/lux/control/remember.lux @@ -44,7 +44,7 @@ (wrap date) (#try.Failure message) - (<>.fail message))))) + (<>.failure message))))) (syntax: #export (remember {deadline ..deadline} {message <c>.text} {focus (<>.maybe <c>.any)}) (let [now (io.run instant.now) @@ -56,7 +56,7 @@ #.None (list))) - (meta.fail (exception.construct ..must_remember [deadline today message focus]))))) + (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)}) diff --git a/stdlib/source/library/lux/control/security/capability.lux b/stdlib/source/library/lux/control/security/capability.lux index 13ae40d15..100eea37e 100644 --- a/stdlib/source/library/lux/control/security/capability.lux +++ b/stdlib/source/library/lux/control/security/capability.lux @@ -8,7 +8,7 @@ ["<c>" code]] ["." io (#+ IO)] [concurrency - ["." promise (#+ Promise)]]] + ["." async (#+ Async)]]] [data [text ["%" format (#+ format)]] @@ -66,6 +66,6 @@ (def: #export (async capability) (All [brand input output] (-> (Capability brand input (IO output)) - (Capability brand input (Promise output)))) - (..forge (|>> ((:representation capability)) promise.future))) + (Capability brand input (Async output)))) + (..forge (|>> ((:representation capability)) async.future))) ) diff --git a/stdlib/source/library/lux/data/collection/list.lux b/stdlib/source/library/lux/data/collection/list.lux index 7ef0d0e31..92b77bdf4 100644 --- a/stdlib/source/library/lux/data/collection/list.lux +++ b/stdlib/source/library/lux/data/collection/list.lux @@ -455,21 +455,21 @@ output' (recur input' output'))))) -(macro: #export (zip tokens state) +(macro: #export (zipped tokens state) {#.doc (doc "Create list zippers with the specified number of input lists." - (def: #export zip/2 (zip 2)) - (def: #export zip/3 (zip 3)) - ((zip 3) xs ys zs))} + (def: #export zipped/2 (zipped 2)) + (def: #export zipped/3 (zipped 3)) + ((zipped 3) xs ys zs))} (case tokens (^ (list [_ (#.Nat num_lists)])) (if (n.> 0 num_lists) (let [(^open ".") ..functor indices (..indices num_lists) type_vars (: (List Code) (map (|>> nat@encode identifier$) indices)) - zip_type (` (All [(~+ type_vars)] - (-> (~+ (map (: (-> Code Code) (function (_ var) (` (List (~ var))))) - type_vars)) - (List [(~+ type_vars)])))) + zipped_type (` (All [(~+ type_vars)] + (-> (~+ (map (: (-> Code Code) (function (_ var) (` (List (~ var))))) + type_vars)) + (List [(~+ type_vars)])))) vars+lists (|> indices (map inc) (map (function (_ idx) @@ -481,7 +481,7 @@ g!step (identifier$ "0step0") g!blank (identifier$ "0,0") list_vars (map product.right vars+lists) - code (` (: (~ zip_type) + code (` (: (~ zipped_type) (function ((~ g!step) (~+ list_vars)) (case [(~+ list_vars)] (~ pattern) @@ -491,19 +491,19 @@ (~ g!blank) #.Nil))))] (#.Right [state (list code)])) - (#.Left "Cannot zip 0 lists.")) + (#.Left "Cannot zipped 0 lists.")) _ - (#.Left "Wrong syntax for zip"))) + (#.Left "Wrong syntax for zipped"))) -(def: #export zip/2 (zip 2)) -(def: #export zip/3 (zip 3)) +(def: #export zipped/2 (zipped 2)) +(def: #export zipped/3 (zipped 3)) -(macro: #export (zip_with tokens state) +(macro: #export (zipped_with tokens state) {#.doc (doc "Create list zippers with the specified number of input lists." - (def: #export zip_with/2 (zip_with 2)) - (def: #export zip_with/3 (zip_with 3)) - ((zip_with 2) + xs ys))} + (def: #export zipped_with/2 (zipped_with 2)) + (def: #export zipped_with/3 (zipped_with 3)) + ((zipped_with 2) + xs ys))} (case tokens (^ (list [_ (#.Nat num_lists)])) (if (n.> 0 num_lists) @@ -512,11 +512,11 @@ g!return_type (identifier$ "0return_type0") g!func (identifier$ "0func0") type_vars (: (List Code) (map (|>> nat@encode identifier$) indices)) - zip_type (` (All [(~+ type_vars) (~ g!return_type)] - (-> (-> (~+ type_vars) (~ g!return_type)) - (~+ (map (: (-> Code Code) (function (_ var) (` (List (~ var))))) - type_vars)) - (List (~ g!return_type))))) + zipped_type (` (All [(~+ type_vars) (~ g!return_type)] + (-> (-> (~+ type_vars) (~ g!return_type)) + (~+ (map (: (-> Code Code) (function (_ var) (` (List (~ var))))) + type_vars)) + (List (~ g!return_type))))) vars+lists (|> indices (map inc) (map (function (_ idx) @@ -528,7 +528,7 @@ g!step (identifier$ "0step0") g!blank (identifier$ "0,0") list_vars (map product.right vars+lists) - code (` (: (~ zip_type) + code (` (: (~ zipped_type) (function ((~ g!step) (~ g!func) (~+ list_vars)) (case [(~+ list_vars)] (~ pattern) @@ -538,13 +538,13 @@ (~ g!blank) #.Nil))))] (#.Right [state (list code)])) - (#.Left "Cannot zip_with 0 lists.")) + (#.Left "Cannot zipped_with 0 lists.")) _ - (#.Left "Wrong syntax for zip_with"))) + (#.Left "Wrong syntax for zipped_with"))) -(def: #export zip_with/2 (zip_with 2)) -(def: #export zip_with/3 (zip_with 3)) +(def: #export zipped_with/2 (zipped_with 2)) +(def: #export zipped_with/3 (zipped_with 3)) (def: #export (last xs) (All [a] (-> (List a) (Maybe a))) diff --git a/stdlib/source/library/lux/data/color.lux b/stdlib/source/library/lux/data/color.lux index 5e6f20eb6..68cf97171 100644 --- a/stdlib/source/library/lux/data/color.lux +++ b/stdlib/source/library/lux/data/color.lux @@ -284,7 +284,7 @@ #green (..up green) #blue (..up blue)})))) -(def: (normalize ratio) +(def: (normal ratio) (-> Frac Frac) (cond (f.> +1.0 ratio) (f.% +1.0 ratio) @@ -297,7 +297,7 @@ (def: #export (interpolate ratio end start) (-> Frac Color Color Color) - (let [dS (..normalize ratio) + (let [dS (..normal ratio) dE (|> +1.0 (f.- dS)) interpolate' (: (-> Nat Nat Nat) (function (_ end start) @@ -326,7 +326,7 @@ (let [[hue saturation luminance] (to_hsl color)] (of_hsl [hue (|> saturation - (f.* (|> +1.0 (<op> (..normalize ratio)))) + (f.* (|> +1.0 (<op> (..normal ratio)))) (f.min +1.0)) luminance])))] @@ -346,10 +346,10 @@ (-> Color [Color Color Color]) (let [[hue saturation luminance] (to_hsl color)] [color - (of_hsl [(|> hue (f.+ <1>) ..normalize) + (of_hsl [(|> hue (f.+ <1>) ..normal) saturation luminance]) - (of_hsl [(|> hue (f.+ <2>) ..normalize) + (of_hsl [(|> hue (f.+ <2>) ..normal) saturation luminance])]))] @@ -363,13 +363,13 @@ (-> Color [Color Color Color Color]) (let [[hue saturation luminance] (to_hsb color)] [color - (of_hsb [(|> hue (f.+ <1>) ..normalize) + (of_hsb [(|> hue (f.+ <1>) ..normal) saturation luminance]) - (of_hsb [(|> hue (f.+ <2>) ..normalize) + (of_hsb [(|> hue (f.+ <2>) ..normal) saturation luminance]) - (of_hsb [(|> hue (f.+ <3>) ..normalize) + (of_hsb [(|> hue (f.+ <3>) ..normal) saturation luminance])]))] @@ -386,9 +386,9 @@ (def: #export (analogous spread variations color) (-> Spread Nat Color (List Color)) (let [[hue saturation brightness] (to_hsb color) - spread (..normalize spread)] + spread (..normal spread)] (list\map (function (_ idx) - (of_hsb [(|> idx inc .int int.frac (f.* spread) (f.+ hue) ..normalize) + (of_hsb [(|> idx inc .int int.frac (f.* spread) (f.+ hue) ..normal) saturation brightness])) (list.indices variations)))) @@ -396,12 +396,12 @@ (def: #export (monochromatic spread variations color) (-> Spread Nat Color (List Color)) (let [[hue saturation brightness] (to_hsb color) - spread (..normalize spread)] + spread (..normal spread)] (|> (list.indices variations) (list\map (|>> inc .int int.frac (f.* spread) (f.+ brightness) - ..normalize + ..normal [hue saturation] of_hsb))))) diff --git a/stdlib/source/library/lux/data/format/css/property.lux b/stdlib/source/library/lux/data/format/css/property.lux index 132aea2e2..73544c26a 100644 --- a/stdlib/source/library/lux/data/format/css/property.lux +++ b/stdlib/source/library/lux/data/format/css/property.lux @@ -17,43 +17,43 @@ Color Location Fit Slice - Alignment Animation-Direction - Animation Animation-Fill - Column-Fill Column-Span + Alignment Animation_Direction + Animation Animation_Fill + Column_Fill Column_Span Iteration Count Play Timing Visibility Attachment Blend Span Image Angle Repeat Border - Collapse Box-Decoration-Break Caption + Collapse Box_Decoration_Break Caption Float Clear Content Cursor Shadow Clip - Text-Direction + Text_Direction Display Empty Filter - Flex-Direction Flex-Wrap - Font Font-Kerning Font-Size Font-Variant - Grid Grid-Content Grid-Flow Grid-Span Grid-Template - Hanging-Punctuation Hyphens Isolation - List-Style-Position List-Style-Type - Overflow Page-Break Pointer-Events + Flex_Direction Flex_Wrap + Font Font_Kerning Font_Size Font_Variant + Grid Grid_Content Grid_Flow Grid_Span Grid_Template + Hanging_Punctuation Hyphens Isolation + List_Style_Position List_Style_Type + Overflow Page_Break Pointer_Events Position Quotes - Resize Scroll-Behavior Table-Layout - Text-Align Text-Align-Last - Text-Decoration-Line Text-Decoration-Style - Text-Justification Text-Overflow Text-Transform - Transform Transform-Origin Transform-Style + Resize Scroll_Behavior Table_Layout + Text_Align Text_Align_Last + Text_Decoration_Line Text_Decoration_Style + Text_Justification Text_Overflow Text_Transform + Transform Transform_Origin Transform_Style Transition - Bidi User-Select - Vertical-Align - White-Space Word-Break Word-Wrap Writing-Mode - Z-Index)]]) + Bidi User_Select + Vertical_Align + White_Space Word_Break Word_Wrap Writing_Mode + Z_Index)]]) -(syntax: (text-identifier {identifier s.text}) - (wrap (list (code.local-identifier identifier)))) +(syntax: (text_identifier {identifier s.text}) + (wrap (list (code.local_identifier (text.replace_all "-" "_" identifier))))) (abstract: #export (Property brand) Text @@ -70,13 +70,13 @@ (~~ (template.spliced <alias>+)))) - (with-expansions [<rows> (template.spliced <property>+)] - (template [<property>] - [(`` (def: #export (~~ (text-identifier <property>)) - (Property <brand>) - (:abstraction <property>)))] - - <rows>))] + (with_expansions [<rows> (template.spliced <property>+)] + (template [<property>] + [(`` (def: #export (~~ (text_identifier <property>)) + (Property <brand>) + (:abstraction <property>)))] + + <rows>))] [All [] @@ -131,7 +131,7 @@ [["border-image-slice"]]] [Color - [[text-color "color"]] + [[text_color "color"]] [["background-color"] ["border-color"] ["border-bottom-color"] @@ -154,19 +154,19 @@ [] [["animation-name"]]] - [Animation-Direction + [Animation_Direction [] [["animation-direction"]]] - [Animation-Fill + [Animation_Fill [] [["animation-fill-mode"]]] - [Column-Fill + [Column_Fill [] [["column-fill"]]] - [Column-Span + [Column_Span [] [["column-span"]]] @@ -263,7 +263,7 @@ [] [["border-collapse"]]] - [Box-Decoration-Break + [Box_Decoration_Break [] [["box-decoration-break"]]] @@ -293,8 +293,8 @@ [] [["cursor"]]] - [Text-Direction - [[text-direction "direction"]] + [Text_Direction + [[text_direction "direction"]] []] [Display @@ -309,11 +309,11 @@ [] [["filter"]]] - [Flex-Direction + [Flex_Direction [] [["flex-direction"]]] - [Flex-Wrap + [Flex_Wrap [] [["flex-wrap"]]] @@ -325,11 +325,11 @@ [] [["font-family"]]] - [Font-Kerning + [Font_Kerning [] [["font-kerning"]]] - [Font-Size + [Font_Size [] [["font-size"]]] @@ -338,7 +338,7 @@ [["font-size-adjust"] ["opacity"]]] - [Font-Variant + [Font_Variant [] [["font-variant"]]] @@ -346,29 +346,29 @@ [] [["grid-area"]]] - [Grid-Content + [Grid_Content [] [["grid-auto-columns"] ["grid-auto-rows"] ["grid-template-columns"] ["grid-template-rows"]]] - [Grid-Flow + [Grid_Flow [] [["grid-auto-flow"]]] - [Grid-Span + [Grid_Span [] [["grid-column-end"] ["grid-column-start"] ["grid-row-end"] ["grid-row-start"]]] - [Grid-Template + [Grid_Template [] [["grid-template-areas"]]] - [Hanging-Punctuation + [Hanging_Punctuation [] [["hanging-punctuation"]]] @@ -380,11 +380,11 @@ [] [["isolation"]]] - [List-Style-Position + [List_Style_Position [] [["list-style-position"]]] - [List-Style-Type + [List_Style_Type [] [["list-style-type"]]] @@ -394,13 +394,13 @@ ["overflow-x"] ["overflow-y"]]] - [Page-Break + [Page_Break [] [["page-break-after"] ["page-break-before"] ["page-break-inside"]]] - [Pointer-Events + [Pointer_Events [] [["pointer-events"]]] @@ -416,39 +416,39 @@ [] [["resize"]]] - [Scroll-Behavior + [Scroll_Behavior [] [["scroll-behavior"]]] - [Table-Layout + [Table_Layout [] [["table-layout"]]] - [Text-Align + [Text_Align [] [["text-align"]]] - [Text-Align-Last + [Text_Align_Last [] [["text-align-last"]]] - [Text-Decoration-Line + [Text_Decoration_Line [] [["text-decoration-line"]]] - [Text-Decoration-Style + [Text_Decoration_Style [] [["text-decoration-style"]]] - [Text-Justification + [Text_Justification [] [["text-justify"]]] - [Text-Overflow + [Text_Overflow [] [["text-overflow"]]] - [Text-Transform + [Text_Transform [] [["text-transform"]]] @@ -456,11 +456,11 @@ [] [["transform"]]] - [Transform-Origin + [Transform_Origin [] [["transform-origin"]]] - [Transform-Style + [Transform_Style [] [["transform-style"]]] @@ -472,31 +472,31 @@ [] [["unicode-bidi"]]] - [User-Select + [User_Select [] [["user-select"]]] - [Vertical-Align + [Vertical_Align [] [["vertical-align"]]] - [White-Space + [White_Space [] [["white-space"]]] - [Word-Break + [Word_Break [] [["word-break"]]] - [Word-Wrap + [Word_Wrap [] [["word-wrap"]]] - [Writing-Mode + [Writing_Mode [] [["writing-mode"]]] - [Z-Index + [Z_Index [] [["z-index"]]] ) diff --git a/stdlib/source/library/lux/data/format/css/selector.lux b/stdlib/source/library/lux/data/format/css/selector.lux index 36f9b7796..330f6a907 100644 --- a/stdlib/source/library/lux/data/format/css/selector.lux +++ b/stdlib/source/library/lux/data/format/css/selector.lux @@ -25,8 +25,8 @@ [(abstract: <brand> Any) (type: #export <generic> (Generic <brand>))] - [Can-Chain Can-Chain'] - [Cannot-Chain Cannot-Chain'] + [Can_Chain Can_Chain'] + [Cannot_Chain Cannot_Chain'] ) (abstract: #export Unique Any) @@ -41,11 +41,11 @@ (|>> :representation)) (def: #export any - (Selector Cannot-Chain) + (Selector Cannot_Chain) (:abstraction "*")) (def: #export tag - (-> Tag (Selector Cannot-Chain)) + (-> Tag (Selector Cannot_Chain)) (|>> :abstraction)) (template [<name> <type> <prefix> <kind>] @@ -54,7 +54,7 @@ (|>> (format <prefix>) :abstraction))] [id ID "#" Unique] - [class Class "." Can-Chain] + [class Class "." Can_Chain] ) (template [<right> <left> <combo> <combinator>+] @@ -67,7 +67,7 @@ (~~ (template.spliced <combinator>+))))] - [Can-Chain (Generic Any) Can-Chain + [Can_Chain (Generic Any) Can_Chain [["" and]]] [Unique (Generic Any) Composite [["" for]]] @@ -85,17 +85,17 @@ (-> (Selector Any) (Selector Any) (Selector Composite))) (def: #export (with? attribute) - (-> Attribute (Selector Can-Chain)) + (-> Attribute (Selector Can_Chain)) (:abstraction (format "[" attribute "]"))) (template [<check> <name>] [(def: #export (<name> attribute value) - (-> Attribute Text (Selector Can-Chain)) + (-> Attribute Text (Selector Can_Chain)) (:abstraction (format "[" attribute <check> value "]")))] ["=" is?] ["~=" has?] - ["|=" has-start?] + ["|=" has_start?] ["^=" starts?] ["$=" ends?] ["*=" contains?] @@ -104,34 +104,34 @@ (template [<kind> <pseudo>+] [(`` (template [<name> <pseudo>] [(def: #export <name> - (Selector Can-Chain) + (Selector Can_Chain) (:abstraction <pseudo>))] (~~ (template.spliced <pseudo>+))))] - [Can-Chain + [Can_Chain [[active ":active"] [checked ":checked"] [default ":default"] [disabled ":disabled"] [empty ":empty"] [enabled ":enabled"] - [first-child ":first-child"] - [first-of-type ":first-of-type"] + [first_child ":first-child"] + [first_of_type ":first-of-type"] [focused ":focus"] [hovered ":hover"] - [in-range ":in-range"] + [in_range ":in-range"] [indeterminate ":indeterminate"] [invalid ":invalid"] - [last-child ":last-child"] - [last-of-type ":last-of-type"] + [last_child ":last-child"] + [last_of_type ":last-of-type"] [link ":link"] - [only-of-type ":only-of-type"] - [only-child ":only-child"] + [only_of_type ":only-of-type"] + [only_child ":only-child"] [optional ":optional"] - [out-of-range ":out-of-range"] - [read-only ":read-only"] - [read-write ":read-write"] + [out_of_range ":out-of-range"] + [read_only ":read-only"] + [read_write ":read-write"] [required ":required"] [root ":root"] [target ":target"] @@ -141,14 +141,14 @@ [Specific [[after "::after"] [before "::before"] - [first-letter "::first-letter"] - [first-line "::first-line"] + [first_letter "::first-letter"] + [first_line "::first-line"] [placeholder "::placeholder"] [selection "::selection"]]] ) (def: #export (language locale) - (-> Locale (Selector Can-Chain)) + (-> Locale (Selector Can_Chain)) (|> locale locale.code (text.enclose ["(" ")"]) @@ -156,7 +156,7 @@ :abstraction)) (def: #export not - (-> (Selector Any) (Selector Can-Chain)) + (-> (Selector Any) (Selector Can_Chain)) (|>> :representation (text.enclose ["(" ")"]) (format ":not") @@ -190,16 +190,16 @@ (template [<name> <pseudo>] [(def: #export (<name> index) - (-> Index (Selector Can-Chain)) + (-> Index (Selector Can_Chain)) (|> (:representation index) (text.enclose ["(" ")"]) (format <pseudo>) (:abstraction Selector)))] - [nth-child ":nth-child"] - [nth-last-child ":nth-last-child"] - [nth-last-of-type ":nth-last-of-type"] - [nth-of-type ":nth-of-type"] + [nth_child ":nth-child"] + [nth_last_child ":nth-last-child"] + [nth_last_of_type ":nth-last-of-type"] + [nth_of_type ":nth-of-type"] ) ) ) diff --git a/stdlib/source/library/lux/data/format/html.lux b/stdlib/source/library/lux/data/format/html.lux index 7cbf607ce..6cd460f9d 100644 --- a/stdlib/source/library/lux/data/format/html.lux +++ b/stdlib/source/library/lux/data/format/html.lux @@ -49,21 +49,21 @@ #Top "_top" (#Frame name) name)) -(def: sanitize +(def: safe {#.doc "Properly formats text to ensure no injection can happen on the HTML."} (-> Text Text) - (|>> (text.replace-all "&" "&") - (text.replace-all "<" "<") - (text.replace-all ">" ">") - (text.replace-all text.double-quote """) - (text.replace-all "'" "'") - (text.replace-all "/" "/"))) + (|>> (text.replace_all "&" "&") + (text.replace_all "<" "<") + (text.replace_all ">" ">") + (text.replace_all text.double_quote """) + (text.replace_all "'" "'") + (text.replace_all "/" "/"))) (def: attributes (-> Attributes Text) (|>> (list\map (function (_ [key val]) - (format key "=" text.double-quote (..sanitize val) text.double-quote))) - (text.join-with " "))) + (format key "=" text.double_quote (..safe val) text.double_quote))) + (text.join_with " "))) (def: (open tag attributes) (-> Tag Attributes Text) @@ -97,13 +97,13 @@ [Document Document'] ) - (template [<super> <super-raw> <sub>+] - [(abstract: #export (<super-raw> brand) Any) - (type: #export <super> (HTML (<super-raw> Any))) + (template [<super> <super_raw> <sub>+] + [(abstract: #export (<super_raw> brand) Any) + (type: #export <super> (HTML (<super_raw> Any))) - (`` (template [<sub> <sub-raw>] - [(abstract: #export <sub-raw> Any) - (type: #export <sub> (HTML (<super-raw> <sub-raw>)))] + (`` (template [<sub> <sub_raw>] + [(abstract: #export <sub_raw> Any) + (type: #export <sub> (HTML (<super_raw> <sub_raw>)))] (~~ (template.spliced <sub>+))))] @@ -193,7 +193,7 @@ (def: #export text (-> Text Content) - (|>> ..sanitize + (|>> ..safe :abstraction)) (template [<tag> <alias> <name>] @@ -202,8 +202,8 @@ (..simple <tag> (list))) (def: #export <alias> <name>)] - ["br" br line-break] - ["wbr" wbr word-break] + ["br" br line_break] + ["wbr" wbr word_break] ["hr" hr separator] ) @@ -223,12 +223,12 @@ {#horizontal Nat #vertical Nat}) - (def: metric-separator ",") - (def: coord-separator ",") + (def: metric_separator ",") + (def: coord_separator ",") (def: (%coord [horizontal vertical]) (Format Coord) - (format (%.nat horizontal) ..metric-separator (%.nat vertical))) + (format (%.nat horizontal) ..metric_separator (%.nat vertical))) (type: #export Rectangle {#start Coord @@ -246,17 +246,17 @@ (def: (%rectangle [start end]) (Format Rectangle) - (format (%coord start) ..coord-separator (%coord end))) + (format (%coord start) ..coord_separator (%coord end))) (def: (%circle [center radius]) (Format Circle) - (format (%coord center) ..metric-separator (%.nat radius))) + (format (%coord center) ..metric_separator (%.nat radius))) (def: (%polygon [first second third extra]) (Format Polygon) (|> (list& first second third extra) (list\map %coord) - (text.join-with ..coord-separator))) + (text.join_with ..coord_separator))) (type: #export Shape (#Rectangle Rectangle) @@ -312,10 +312,10 @@ ) (template [<name> <tag>] - [(def: #export (<name> attributes media on-unsupported) + [(def: #export (<name> attributes media on_unsupported) (-> Attributes Media (Maybe Content) Element) (..tag <tag> attributes - (|> on-unsupported + (|> on_unsupported (maybe.default (..text "")) (..and media))))] @@ -335,21 +335,21 @@ (-> ID Input) (|>> ["for"] list (..empty "label"))) - (template [<name> <container-tag> <description-tag> <type>] + (template [<name> <container_tag> <description_tag> <type>] [(def: #export (<name> description attributes content) (-> (Maybe Content) Attributes <type> <type>) - (..tag <container-tag> attributes + (..tag <container_tag> attributes (case description (#.Some description) ($_ ..and - (..tag <description-tag> (list) description) + (..tag <description_tag> (list) description) content) #.None content)))] [details "details" "summary" Element] - [field-set "fieldset" "legend" Input] + [field_set "fieldset" "legend" Input] [figure "figure" "figcaption" Element] ) @@ -360,7 +360,7 @@ (maybe.default (..text "")) (..tag <tag> attributes)))] - [text-area "textarea" Input] + [text_area "textarea" Input] [iframe "iframe" Element] ) @@ -372,7 +372,7 @@ (..tag <tag>))] [abbrebiation "abbr"] - [block-quote "blockquote"] + [block_quote "blockquote"] [bold "b"] [cite "cite"] [code "code"] @@ -405,7 +405,7 @@ (def: #export incorrect ..struck) - (def: (ruby-pronunciation pronunciation) + (def: (ruby_pronunciation pronunciation) (-> Content (HTML Any)) (..tag "rt" (list) ($_ ..and @@ -418,9 +418,10 @@ (..tag "ruby" attributes ($_ ..and content - (ruby-pronunciation pronunciation)))) + (ruby_pronunciation pronunciation)))) - (type: #export Composite (-> Attributes Element Element)) + (type: #export Composite + (-> Attributes Element Element)) (template [<name> <tag>] [(def: #export <name> @@ -449,7 +450,7 @@ ["dd" description Element] ) - (def: #export (description-list attributes descriptions) + (def: #export (description_list attributes descriptions) (-> Attributes (List [Content Element]) Element) (case (list\map (function (_ [term description]) ($_ ..and @@ -472,11 +473,11 @@ [button "button" Element Input] [item "li" Element Item] - [ordered-list "ol" Item Element] - [unordered-list "ul" Item Element] + [ordered_list "ol" Item Element] + [unordered_list "ul" Item Element] [option "option" Content Option] - [option-group "optgroup" Option Option] - [data-list "datalist" Option Element] + [option_group "optgroup" Option Option] + [data_list "datalist" Option Element] [select "select" Option Input] [address "address" Element Element] [form "form" Input Element] @@ -490,10 +491,10 @@ (..tag <tag> (list)))] [title "title" Content Meta] - [no-script "noscript" Content Meta] + [no_script "noscript" Content Meta] [template "template" (HTML Any) (HTML Nothing)] - [table-header "th" Element Header] - [table-cell "td" Element Cell] + [table_header "th" Element Header] + [table_cell "td" Element Cell] [head "head" Meta Head] [body "body" Element Body] ) @@ -503,23 +504,23 @@ (-> <input> <output>) (..tag <tag> (list)))] - [table-row "tr" (HTML Any) Row] - [table-head "thead" Row HTML] - [table-body "tbody" Row HTML] - [table-foot "tfoot" Row HTML] - [columns-group "colgroup" Column HTML] + [table_row "tr" (HTML Any) Row] + [table_head "thead" Row HTML] + [table_body "tbody" Row HTML] + [table_foot "tfoot" Row HTML] + [columns_group "colgroup" Column HTML] ) (def: #export (table attributes caption columns headers rows footer) (-> Attributes (Maybe Content) (Maybe Column) Header (List Cell) (Maybe Cell) Element) - (let [head (..table-head (..table-row headers)) - content (case (list\map table-row rows) + (let [head (..table_head (..table_row headers)) + content (case (list\map table_row rows) #.Nil head (#.Cons first rest) (..and head - (..table-body + (..table_body (list\fold (function.flip ..and) first rest)))) content (case footer #.None @@ -527,13 +528,13 @@ (#.Some footer) (..and content - (..table-foot (..table-row footer)))) + (..table_foot (..table_row footer)))) content (case columns #.None content (#.Some columns) - (..and (..columns-group columns) + (..and (..columns_group columns) content)) content (case caption #.None @@ -545,19 +546,19 @@ (..tag "table" attributes content))) - (template [<name> <doc-type>] + (template [<name> <doc_type>] [(def: #export <name> (-> Head Body Document) - (let [doc-type <doc-type>] + (let [doc_type <doc_type>] (function (_ head body) (|> (..tag "html" (list) (..and head body)) :representation - (format doc-type) + (format doc_type) :abstraction))))] - [html-5 "<!DOCTYPE html>"] - [html-4_01 (format "<!DOCTYPE HTML PUBLIC " text.double-quote "-//W3C//DTD HTML 4.01//EN" text.double-quote " " text.double-quote "http://www.w3.org/TR/html4/strict.dtd" text.double-quote ">")] - [xhtml-1_0 (format "<!DOCTYPE html PUBLIC " text.double-quote "-//W3C//DTD XHTML 1.0 Strict//EN" text.double-quote " " text.double-quote "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd" text.double-quote ">")] - [xhtml-1_1 (format "<!DOCTYPE html PUBLIC " text.double-quote "-//W3C//DTD XHTML 1.1//EN" text.double-quote " " text.double-quote "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd" text.double-quote ">")] + [html/5 "<!DOCTYPE html>"] + [html/4_01 (format "<!DOCTYPE HTML PUBLIC " text.double_quote "-//W3C//DTD HTML 4.01//EN" text.double_quote " " text.double_quote "http://www.w3.org/TR/html4/strict.dtd" text.double_quote ">")] + [xhtml/1_0 (format "<!DOCTYPE html PUBLIC " text.double_quote "-//W3C//DTD XHTML 1.0 Strict//EN" text.double_quote " " text.double_quote "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd" text.double_quote ">")] + [xhtml/1_1 (format "<!DOCTYPE html PUBLIC " text.double_quote "-//W3C//DTD XHTML 1.1//EN" text.double_quote " " text.double_quote "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd" text.double_quote ">")] ) ) diff --git a/stdlib/source/library/lux/data/format/json.lux b/stdlib/source/library/lux/data/format/json.lux index 638048599..30903df3c 100644 --- a/stdlib/source/library/lux/data/format/json.lux +++ b/stdlib/source/library/lux/data/format/json.lux @@ -99,7 +99,7 @@ (wrap (` [(~ (code.text key_name)) (~ (wrapper value))])) _ - (meta.fail "Wrong syntax for JSON object."))) + (meta.failure "Wrong syntax for JSON object."))) pairs)] (wrap (list (` (: JSON (#..Object ((~! dictionary.of_list) (~! text.hash) @@ -208,17 +208,17 @@ ############################################################ ############################################################ -(def: (format_null _) +(def: (null_format _) (-> Null Text) "null") -(def: format_boolean +(def: boolean_format (-> Boolean Text) (|>> (case> #0 "false" #1 "true"))) -(def: format_number +(def: number_format (-> Number Text) (|>> (case> (^or +0.0 -0.0) "0.0" @@ -230,7 +230,7 @@ (def: escape "\") (def: escaped_dq (text\compose ..escape text.double_quote)) -(def: format_string +(def: string_format (-> String Text) (|>> (text.replace_all text.double_quote ..escaped_dq) (text.enclose [text.double_quote text.double_quote]))) @@ -250,25 +250,25 @@ ["}" close_object] ) -(def: (format_array format) +(def: (array_format format) (-> (-> JSON Text) (-> Array Text)) (|>> (row\map format) row.to_list (text.join_with ..separator) (text.enclose [..open_array ..close_array]))) -(def: (format_kv format [key value]) +(def: (kv_format format [key value]) (-> (-> JSON Text) (-> [String JSON] Text)) ($_ text\compose - (..format_string key) + (..string_format key) ..entry_separator (format value) )) -(def: (format_object format) +(def: (object_format format) (-> (-> JSON Text) (-> Object Text)) (|>> dictionary.entries - (list\map (..format_kv format)) + (list\map (..kv_format format)) (text.join_with ..separator) (text.enclose [..open_object ..close_object]))) @@ -278,12 +278,12 @@ (^template [<tag> <format>] [(<tag> value) (<format> value)]) - ([#Null ..format_null] - [#Boolean ..format_boolean] - [#Number ..format_number] - [#String ..format_string] - [#Array (..format_array format)] - [#Object (..format_object format)]) + ([#Null ..null_format] + [#Boolean ..boolean_format] + [#Number ..number_format] + [#String ..string_format] + [#Array (..array_format format)] + [#Object (..object_format format)]) )) ############################################################ @@ -341,7 +341,7 @@ (wrap ($_ text\compose mark (if signed?' "-" "") offset))))] (case (f\decode ($_ text\compose (if signed? "-" "") digits "." decimals exp)) (#try.Failure message) - (<>.fail message) + (<>.failure message) (#try.Success value) (wrap value)))) diff --git a/stdlib/source/library/lux/data/format/markdown.lux b/stdlib/source/library/lux/data/format/markdown.lux index 5dba35fed..68af40458 100644 --- a/stdlib/source/library/lux/data/format/markdown.lux +++ b/stdlib/source/library/lux/data/format/markdown.lux @@ -13,7 +13,7 @@ ## https://www.markdownguide.org/basic-syntax/ -(def: sanitize +(def: safe (-> Text Text) (|>> (text.replace_all "\" "\\") (text.replace_all "`" "\`") @@ -43,7 +43,7 @@ (def: #export text (-> Text (Markdown Span)) - (|>> ..sanitize :abstraction)) + (|>> ..safe :abstraction)) (def: blank_line (format text.new_line text.new_line)) @@ -51,7 +51,7 @@ (template [<name> <prefix>] [(def: #export (<name> content) (-> Text Markdown) - (:abstraction (format <prefix> " " (..sanitize content) ..blank_line)))] + (:abstraction (format <prefix> " " (..safe content) ..blank_line)))] [heading/1 "#"] [heading/2 "##"] @@ -135,7 +135,7 @@ (def: #export snippet {#.doc "A snippet of code."} (-> Text (Markdown Span)) - (|>> ..sanitize (text.enclose ["`" "`"]) :abstraction)) + (|>> ..safe (text.enclose ["`" "`"]) :abstraction)) (def: #export code {#.doc "A block of code."} @@ -146,7 +146,7 @@ (def: #export (image description url) (-> Text URL (Markdown Span)) - (:abstraction (format "![" (..sanitize description) "](" url ")"))) + (:abstraction (format "![" (..safe description) "](" url ")"))) (def: #export horizontal_rule (Markdown Block) diff --git a/stdlib/source/library/lux/data/format/xml.lux b/stdlib/source/library/lux/data/format/xml.lux index 867b24cb6..7dd861762 100644 --- a/stdlib/source/library/lux/data/format/xml.lux +++ b/stdlib/source/library/lux/data/format/xml.lux @@ -292,7 +292,7 @@ (\ (dictionary.equivalence text.equivalence) = reference/attrs sample/attrs) (n.= (list.size reference/children) (list.size sample/children)) - (|> (list.zip/2 reference/children sample/children) + (|> (list.zipped/2 reference/children sample/children) (list.every? (product.uncurry =)))) _ diff --git a/stdlib/source/library/lux/data/text/escape.lux b/stdlib/source/library/lux/data/text/escape.lux index 1002859cc..08724a881 100644 --- a/stdlib/source/library/lux/data/text/escape.lux +++ b/stdlib/source/library/lux/data/text/escape.lux @@ -241,4 +241,4 @@ (wrap (list (code.text un_escaped))) (#try.Failure error) - (meta.fail error))) + (meta.failure error))) diff --git a/stdlib/source/library/lux/data/text/regex.lux b/stdlib/source/library/lux/data/text/regex.lux index 506dca6ab..c390e1c08 100644 --- a/stdlib/source/library/lux/data/text/regex.lux +++ b/stdlib/source/library/lux/data/text/regex.lux @@ -466,8 +466,8 @@ (case (<t>.run (regex^ current_module) pattern) (#try.Failure error) - (meta.fail (format "Error while parsing regular-expression:" //.new_line - error)) + (meta.failure (format "Error while parsing regular-expression:" //.new_line + error)) (#try.Success regex) (wrap (list regex)) diff --git a/stdlib/source/library/lux/debug.lux b/stdlib/source/library/lux/debug.lux index 93506c541..4ca51d344 100644 --- a/stdlib/source/library/lux/debug.lux +++ b/stdlib/source/library/lux/debug.lux @@ -129,18 +129,18 @@ (#.Cons member (recur (inc idx))))))))} (as_is)) -(def: (inspect_tuple inspect) +(def: (tuple_inspection inspection) (-> Inspector Inspector) (with_expansions [<adaption> (for {@.lua (~~ (as_is ..tuple_array))} (~~ (as_is)))] (`` (|>> (:as (array.Array Any)) <adaption> array.to_list - (list\map inspect) + (list\map inspection) (text.join_with " ") (text.enclose ["[" "]"]))))) -(def: #export (inspect value) +(def: #export (inspection value) Inspector (with_expansions [<jvm> (let [object (:as java/lang/Object value)] (`` (<| (~~ (template [<class> <processing>] @@ -170,11 +170,11 @@ #.None #0)] (|> (%.format (%.nat (.nat (java/lang/Integer::longValue tag))) " " (%.bit last?) - " " (inspect choice)) + " " (inspection choice)) (text.enclose ["(" ")"]))) _ - (inspect_tuple inspect value))) + (tuple_inspection inspection value))) #.None) (java/lang/Object::toString object))))] (for {@.old <jvm> @@ -199,7 +199,7 @@ ("js object undefined?" variant_value))) (|> (%.format (JSON::stringify variant_tag) " " (%.bit (not ("js object null?" variant_flag))) - " " (inspect variant_value)) + " " (inspection variant_value)) (text.enclose ["(" ")"])) (not (or ("js object undefined?" ("js object get" "_lux_low" value)) @@ -207,7 +207,7 @@ (|> value (:as .Int) %.int) (Array::isArray value) - (inspect_tuple inspect value) + (tuple_inspection inspection value) ## else (JSON::stringify value))) @@ -227,7 +227,7 @@ ["<type 'unicode'>" "<class 'unicode'>" [(:as .Text) %.text]]) (^or "<type 'list'>" "<class 'list'>") - (inspect_tuple inspect value) + (tuple_inspection inspection value) (^or "<type 'tuple'>" "<type 'tuple'>") (let [variant (:as (array.Array Any) value)] @@ -240,7 +240,7 @@ (..str value) (|> (%.format (|> variant_tag (:as .Nat) %.nat) " " (|> variant_flag "python object none?" not %.bit) - " " (inspect variant_value)) + " " (inspection variant_value)) (text.enclose ["(" ")"])))) _ (..str value))) @@ -270,10 +270,10 @@ variant_value ("lua object get" "_lux_value" value)] (if (or ("lua object nil?" variant_tag) ("lua object nil?" variant_value)) - (inspect_tuple inspect value) + (tuple_inspection inspection value) (|> (%.format (|> variant_tag (:as .Nat) %.nat) " " (%.bit (not ("lua object nil?" variant_flag))) - " " (inspect variant_value)) + " " (inspection variant_value)) (text.enclose ["(" ")"])))) _ @@ -308,14 +308,14 @@ variant_value ("ruby object get" "_lux_value" value)] (if (or ("ruby object nil?" variant_tag) ("ruby object nil?" variant_value)) - (inspect_tuple inspect value) + (tuple_inspection inspection value) (|> (%.format (|> variant_tag (:as .Nat) %.nat) " " (%.bit (not ("ruby object nil?" variant_flag))) - " " (inspect variant_value)) + " " (inspection variant_value)) (text.enclose ["(" ")"])))) (is? (class_of [[] []]) value_class) - (inspect_tuple inspect value) + (tuple_inspection inspection value) ## else (to_s value))))) @@ -330,7 +330,7 @@ ["double" [(:as .Frac) %.frac]] ["string" [(:as .Text) %.text]] ["NULL" [(new> "null" [])]] - ["array" [(inspect_tuple inspect)]]) + ["array" [(tuple_inspection inspection)]]) "object" (let [variant_tag ("php object get" "_lux_tag" value) @@ -341,7 +341,7 @@ (..strval value) (|> (%.format (|> variant_tag (:as .Nat) %.nat) " " (%.bit (not ("php object null?" variant_flag))) - " " (inspect variant_value)) + " " (inspection variant_value)) (text.enclose ["(" ")"])))) _ @@ -357,7 +357,7 @@ [..real? [(:as .Frac) %.frac]] [..string? [(:as .Text) %.text]] ["scheme object nil?" [(new> "()" [])]] - [..vector? [(inspect_tuple inspect)]])) + [..vector? [(tuple_inspection inspection)]])) (..pair? value) (let [variant_tag (..car value) @@ -369,7 +369,7 @@ variant_value (..cdr variant_rest)] (|> (%.format (|> variant_tag (:as .Nat) %.nat) " " (%.bit (not ("scheme object nil?" variant_flag))) - " " (inspect variant_value)) + " " (inspection variant_value)) (text.enclose ["(" ")"]))) (..format ["~s" value]))) @@ -485,7 +485,7 @@ (%.format (headR leftV) " " (recur tailR rightV)))))] (%.format "[" tuple_body "]")))))) -(def: representation +(def: representation_parser (Parser Representation) (<>.rec (function (_ representation) @@ -502,18 +502,18 @@ (<type>.local (list outputT) representation) #.None - (<>.fail ""))) + (<>.failure ""))) (do <>.monad [[name anonymous] <type>.named] (<type>.local (list anonymous) representation)) - (<>.fail "") + (<>.failure "") )))) -(def: #export (represent type value) +(def: #export (representation type value) (-> Type Any (Try Text)) - (case (<type>.run ..representation type) + (case (<type>.run ..representation_parser type) (#try.Success representation) (#try.Success (representation value)) @@ -589,7 +589,7 @@ (~+ (list\map (function (_ [name format]) (let [format (case format #.None - (` (~! ..inspect)) + (` (~! ..inspection)) (#.Some format) format)] diff --git a/stdlib/source/library/lux/extension.lux b/stdlib/source/library/lux/extension.lux index 5cad0158c..23be093ac 100644 --- a/stdlib/source/library/lux/extension.lux +++ b/stdlib/source/library/lux/extension.lux @@ -79,7 +79,7 @@ (~ body) (#.Left (~ g!error)) - ((~! phase.fail) (~ g!error))) + ((~! phase.failure) (~ g!error))) ))))))))] [<c>.any <c>.end! <c>.and <c>.run "lux def analysis" analysis:] diff --git a/stdlib/source/library/lux/ffi.jvm.lux b/stdlib/source/library/lux/ffi.jvm.lux index 6b45f2fbe..76983acd5 100644 --- a/stdlib/source/library/lux/ffi.jvm.lux +++ b/stdlib/source/library/lux/ffi.jvm.lux @@ -466,7 +466,7 @@ (<code>.tuple (<>.exactly (list.size arguments) <code>.any)))))] (wrap (` ("jvm member invoke constructor" (~ (code.text class_name)) (~+ (|> args - (list.zip/2 (list\map product.right arguments)) + (list.zipped/2 (list\map product.right arguments)) (list\map ..decorate_input)))))))) (def: (make_static_method_parser class_name method_name arguments) @@ -478,7 +478,7 @@ (<code>.tuple (<>.exactly (list.size arguments) <code>.any)))))] (wrap (` ("jvm member invoke static" (~ (code.text class_name)) (~ (code.text method_name)) (~+ (|> args - (list.zip/2 (list\map product.right arguments)) + (list.zipped/2 (list\map product.right arguments)) (list\map ..decorate_input)))))))) (template [<name> <jvm_op>] @@ -492,7 +492,7 @@ (wrap (` (<jvm_op> (~ (code.text class_name)) (~ (code.text method_name)) (~ (code.local_identifier self_name)) (~+ (|> args - (list.zip/2 (list\map product.right arguments)) + (list.zipped/2 (list\map product.right arguments)) (list\map ..decorate_input))))))))] [make_special_method_parser "jvm member invoke special"] @@ -574,7 +574,7 @@ (<>\wrap (list))) (<code>.form (<>.and <code>.local_identifier (<>.some (parameter^ type_vars))))))] - (wrap (type.class (name.sanitize name) parameters)))) + (wrap (type.class (name.safe name) parameters)))) (exception: #export (unexpected_type_variable {name Text} {type_vars (List (Type Var))}) @@ -1141,7 +1141,7 @@ (~ (code.text name)) (~ (code.local_identifier self_name)) (~+ (|> args - (list.zip/2 (list\map product.right arguments)) + (list.zipped/2 (list\map product.right arguments)) (list\map ..decorate_input)))))))))] (` ("override" (~ (declaration$ declaration)) @@ -1159,7 +1159,7 @@ ))) (#StaticMethod strict_fp? type_vars arguments return_type body exs) - (let [replacer (parser->replacer (<>.fail ""))] + (let [replacer (parser->replacer (<>.failure ""))] (` ("static" (~ (code.text name)) (~ (privacy_modifier$ pm)) @@ -1247,7 +1247,7 @@ method_parser (: (Parser Code) (|> methods (list\map (method->parser fully_qualified_class_name)) - (list\fold <>.either (<>.fail ""))))]] + (list\fold <>.either (<>.failure ""))))]] (wrap (list (` ("jvm class" (~ (declaration$ (type.declaration full_class_name class_vars))) (~ (class$ super)) @@ -1297,7 +1297,7 @@ (~ (class$ super)) [(~+ (list\map class$ interfaces))] [(~+ (list\map constructor_arg$ constructor_args))] - [(~+ (list\map (method_def$ "" (<>.fail "") super (list)) methods))]))))) + [(~+ (list\map (method_def$ "" (<>.failure "") super (list)) methods))]))))) (syntax: #export (null) {#.doc (doc "Null object reference." @@ -1551,7 +1551,7 @@ (def: (jvm_invoke_inputs mode classes inputs) (-> Primitive_Mode (List (Type Value)) (List [Bit Code]) (List Code)) (|> inputs - (list.zip/2 classes) + (list.zipped/2 classes) (list\map (function (_ [class [maybe? input]]) (|> (if maybe? (` (: (.primitive (~ (code.text (..reflection class)))) @@ -1598,7 +1598,7 @@ (~ (code.text full_name)) [(~+ (list\map ..var$ (get@ #import_member_tvars commons)))] (~+ (|> (jvm_invoke_inputs (get@ #import_member_mode commons) input_jvm_types arg_function_inputs) - (list.zip/2 input_jvm_types) + (list.zipped/2 input_jvm_types) (list\map ..decorate_input)))))] (auto_convert_output (get@ #import_member_mode commons)) (decorate_return_maybe member true classT) @@ -1638,10 +1638,10 @@ [(~+ (list\map ..var$ (get@ #import_member_tvars commons)))] (~+ (|> object_ast (list\map ..un_quote) - (list.zip/2 (list (type.class full_name (list)))) + (list.zipped/2 (list (type.class full_name (list)))) (list\map (auto_convert_input (get@ #import_member_mode commons))))) (~+ (|> (jvm_invoke_inputs (get@ #import_member_mode commons) input_jvm_types arg_function_inputs) - (list.zip/2 input_jvm_types) + (list.zipped/2 input_jvm_types) (list\map ..decorate_input)))))) jvm_interop (: Code (case (type.void? method_return) @@ -1738,7 +1738,7 @@ #Class)) (#.Left _) - (meta.fail (format "Unknown class: " class_name))))) + (meta.failure (format "Unknown class: " class_name))))) (syntax: #export (import: {declaration ..declaration^} @@ -1781,13 +1781,13 @@ "It should also be noted, the only types that may show up in method arguments or return values may be Java classes, arrays, primitives, void or type-vars." "Lux types, such as Maybe cannot be named (otherwise, they'd be confused for Java classes)." - (import: (lux/concurrency/promise/JvmPromise A) + (import: (lux/concurrency/async/JvmAsync A) ["#::." (resolve [A] boolean) (poll [] A) (wasResolved [] boolean) (waitOn [lux/Function] void) - (#static [A] make [A] (lux/concurrency/promise/JvmPromise A))]) + (#static [A] make [A] (lux/concurrency/async/JvmAsync A))]) "Also, the names of the imported members will look like Class::member" (java/lang/Object::new []) @@ -1833,7 +1833,7 @@ (exception.report ["Lux Type" (%.type type)])) -(with_expansions [<failure> (as_is (meta.fail (exception.construct ..cannot_convert_to_jvm_type [type])))] +(with_expansions [<failure> (as_is (meta.failure (exception.construct ..cannot_convert_to_jvm_type [type])))] (def: (lux_type->jvm_type type) (-> .Type (Meta (Type Value))) (if (lux_type\= .Any type) @@ -2059,4 +2059,4 @@ ("jvm object cast" (~ object)))))) _ - (meta.fail (exception.construct ..cannot_cast_to_non_object [type])))) + (meta.failure (exception.construct ..cannot_cast_to_non_object [type])))) diff --git a/stdlib/source/library/lux/ffi.old.lux b/stdlib/source/library/lux/ffi.old.lux index 5b4d49084..a023d3afe 100644 --- a/stdlib/source/library/lux/ffi.old.lux +++ b/stdlib/source/library/lux/ffi.old.lux @@ -264,7 +264,7 @@ _ #.None)) -(def: sanitize +(def: safe (-> Text Text) (text.replace_all "/" ".")) @@ -283,7 +283,7 @@ output [[name params] _ _] - (let [name (sanitize name) + (let [name (safe name) =params (list\map (class_to_type' mode type_params in_array?) params)] (` (primitive (~ (code.text name)) [(~+ =params)]))))) @@ -335,7 +335,7 @@ (#.Cons bound1 _) (class_to_type #ManualPrM class_params bound1)))) class_params)] - (` (primitive (~ (code.text (sanitize class_name))) + (` (primitive (~ (code.text (safe class_name))) [(~+ =params)])))) (def: type_var_class Text "java.lang.Object") @@ -361,7 +361,7 @@ (simple_class$ env upper_bound) (#GenericClass name env) - (sanitize name) + (safe name) (#GenericArray param') (case param' @@ -987,7 +987,7 @@ name (#GenericClass name params) - (format "(" (sanitize name) " " (spaced (list\map generic_type$ params)) ")") + (format "(" (safe name) " " (spaced (list\map generic_type$ params)) ")") (#GenericArray param) (format "(" array.type_name " " (generic_type$ param) ")") @@ -1004,11 +1004,11 @@ (def: (class_decl$ (^open ".")) (-> Class_Declaration JVM_Code) - (format "(" (sanitize class_name) " " (spaced (list\map type_param$ class_params)) ")")) + (format "(" (safe class_name) " " (spaced (list\map type_param$ class_params)) ")")) (def: (super_class_decl$ (^slots [#super_class_name #super_class_params])) (-> Super_Class_Decl JVM_Code) - (format "(" (sanitize super_class_name) " " (spaced (list\map generic_type$ super_class_params)) ")")) + (format "(" (safe super_class_name) " " (spaced (list\map generic_type$ super_class_params)) ")")) (def: (method_decl$ [[name pm anns] method_decl]) (-> [Member_Declaration MethodDecl] JVM_Code) @@ -1209,11 +1209,11 @@ )} (do meta.monad [current_module meta.current_module_name - #let [fully_qualified_class_name (format (sanitize current_module) "." full_class_name) + #let [fully_qualified_class_name (format (safe current_module) "." full_class_name) field_parsers (list\map (field_to_parser fully_qualified_class_name) fields) method_parsers (list\map (method_to_parser (product.right class_decl) fully_qualified_class_name) methods) replacer (parser_to_replacer (list\fold <>.either - (<>.fail "") + (<>.failure "") (list\compose field_parsers method_parsers))) def_code (format "jvm class:" (spaced (list (class_decl$ class_decl) @@ -1362,7 +1362,7 @@ {#..jvm_class (~ (code.text full_name))} Type (All [(~+ params')] - (primitive (~ (code.text (sanitize full_name))) + (primitive (~ (code.text (safe full_name))) [(~+ params')])))))) (def: (member_type_vars class_tvars member) @@ -1483,7 +1483,7 @@ (if maybe? (` ((~! !!!) (~ (un_quote input)))) (un_quote input)))) - (list.zip/2 classes) + (list.zipped/2 classes) (list\map (auto_convert_input mode)))) (def: (import_name format class member) @@ -1495,7 +1495,7 @@ (def: (member_def_interop type_params kind class [arg_function_inputs arg_classes arg_types] member method_prefix import_format) (-> (List Type_Parameter) Class_Kind Class_Declaration [(List [Bit Code]) (List Text) (List Code)] Import_Member_Declaration Text Text (Meta (List Code))) (let [[full_name class_tvars] class - full_name (sanitize full_name) + full_name (safe full_name) all_params (|> (member_type_vars class_tvars member) (list.only free_type_param?) (list\map type_param_to_type_arg))] @@ -1641,7 +1641,7 @@ (def: (class_kind [class_name _]) (-> Class_Declaration (Meta Class_Kind)) - (let [class_name (..sanitize class_name)] + (let [class_name (..safe class_name)] (case (..load_class class_name) (#try.Success class) (\ meta.monad wrap (if (interface? class) @@ -1649,8 +1649,8 @@ #Class)) (#try.Failure error) - (meta.fail (format "Cannot load class: " class_name text.new_line - error))))) + (meta.failure (format "Cannot load class: " class_name text.new_line + error))))) (syntax: #export (import: {class_decl ..class_decl^} @@ -1692,13 +1692,13 @@ "It should also be noted, the only types that may show up in method arguments or return values may be Java classes, arrays, primitives, void or type-parameters." "Lux types, such as Maybe cannot be named (otherwise, they'd be confused for Java classes)." - (import: (lux/concurrency/promise/JvmPromise A) + (import: (lux/concurrency/async/JvmAsync A) ["#::." (resolve [A] boolean) (poll [] A) (wasResolved [] boolean) (waitOn [lux/Function] void) - (#static [A] make [A] (lux/concurrency/promise/JvmPromise A))]) + (#static [A] make [A] (lux/concurrency/async/JvmAsync A))]) "Also, the names of the imported members will look like Class::member" (java/lang/Object::new []) @@ -1751,7 +1751,7 @@ (#.Apply A F) (case (type.applied (list A) F) #.None - (meta.fail (format "Cannot apply type: " (type.format F) " to " (type.format A))) + (meta.failure (format "Cannot apply type: " (type.format F) " to " (type.format A))) (#.Some type') (type_to_class_name type')) @@ -1760,7 +1760,7 @@ (type_to_class_name type') _ - (meta.fail (format "Cannot convert to JvmType: " (type.format type)))))) + (meta.failure (format "Cannot convert to JvmType: " (type.format type)))))) (syntax: #export (array_read idx array) {#.doc (doc "Loads an element from an array." diff --git a/stdlib/source/library/lux/macro.lux b/stdlib/source/library/lux/macro.lux index 0c72af316..275401a61 100644 --- a/stdlib/source/library/lux/macro.lux +++ b/stdlib/source/library/lux/macro.lux @@ -99,7 +99,7 @@ (wrap [left right]) _ - (//.fail "Record members must expand into singletons."))))) + (//.failure "Record members must expand into singletons."))))) (\ //.monad map (|>> code.record list))) _ @@ -123,7 +123,7 @@ (\ //.monad wrap name) _ - (//.fail (text\compose "Code is not a local identifier: " (code.format ast))))) + (//.failure (text\compose "Code is not a local identifier: " (code.format ast))))) (def: #export wrong_syntax_error (-> Name Text) @@ -152,7 +152,7 @@ (~ body)))))) _ - (//.fail (..wrong_syntax_error (name_of ..with_gensyms))))) + (//.failure (..wrong_syntax_error (name_of ..with_gensyms))))) (def: #export (expand_1 token) {#.doc "Works just like expand, except that it ensures that the output is a single Code token."} @@ -164,7 +164,7 @@ (wrap token') _ - (//.fail "Macro expanded to more than 1 element.")))) + (//.failure "Macro expanded to more than 1 element.")))) (template [<macro> <func>] [(macro: #export (<macro> tokens) @@ -202,7 +202,7 @@ output))) #.None - (//.fail (..wrong_syntax_error macro_name)))))] + (//.failure (..wrong_syntax_error macro_name)))))] [log_expand_once! ..expand_once] [log_expand! ..expand] diff --git a/stdlib/source/library/lux/macro/local.lux b/stdlib/source/library/lux/macro/local.lux index 4eb9c35c6..1fc16815f 100644 --- a/stdlib/source/library/lux/macro/local.lux +++ b/stdlib/source/library/lux/macro/local.lux @@ -50,7 +50,7 @@ (def: (push_one [name macro]) (-> [Name Macro] (Meta Any)) (do meta.monad - [[module_name definition_name] (meta.normalize name) + [[module_name definition_name] (meta.normal name) #let [definition (: Global (#.Definition [false .Macro (' {}) macro])) add_macro! (: (-> (PList Global) (PList Global)) (plist.put definition_name definition))]] @@ -67,7 +67,7 @@ (def: (pop_one name) (-> Name (Meta Any)) (do meta.monad - [[module_name definition_name] (meta.normalize name) + [[module_name definition_name] (meta.normal name) #let [remove_macro! (: (-> (PList Global) (PList Global)) (plist.remove definition_name))]] (..with_module module_name diff --git a/stdlib/source/library/lux/macro/poly.lux b/stdlib/source/library/lux/macro/poly.lux index b40f29a8c..a9f4a5744 100644 --- a/stdlib/source/library/lux/macro/poly.lux +++ b/stdlib/source/library/lux/macro/poly.lux @@ -38,7 +38,7 @@ (~ body))) (~ g!type))) (#.Left (~ g!output)) - ((~! meta.fail) (~ g!output)) + ((~! meta.failure) (~ g!output)) (#.Right (~ g!output)) ((~' wrap) (.list (~ g!output)))))))))))) @@ -58,7 +58,7 @@ {[poly_func poly_args] (<code>.form (<>.and <code>.identifier (<>.many <code>.identifier)))} {?custom_impl (<>.maybe <code>.any)}) (do {! meta.monad} - [poly_args (monad.map ! meta.normalize poly_args) + [poly_args (monad.map ! meta.normal poly_args) name (case ?name (#.Some name) (wrap name) @@ -69,7 +69,7 @@ (wrap derived_name) _ - (<>.fail "derived: was given no explicit name, and cannot generate one from given information.")) + (<>.failure "derived: was given no explicit name, and cannot generate one from given information.")) #let [impl (case ?custom_impl (#.Some custom_impl) custom_impl diff --git a/stdlib/source/library/lux/macro/syntax.lux b/stdlib/source/library/lux/macro/syntax.lux index c2ddeefe5..3ad402530 100644 --- a/stdlib/source/library/lux/macro/syntax.lux +++ b/stdlib/source/library/lux/macro/syntax.lux @@ -102,7 +102,7 @@ (~! </>.any)))]) _ - (meta.fail "Syntax pattern expects records or identifiers.")))) + (meta.failure "Syntax pattern expects records or identifiers.")))) args) this_module meta.current_module_name #let [g!state (code.identifier ["" "*compiler*"]) @@ -126,4 +126,4 @@ (~ g!tokens))))))))) _ - (meta.fail (macro.wrong_syntax_error (name_of ..syntax:)))))) + (meta.failure (macro.wrong_syntax_error (name_of ..syntax:)))))) diff --git a/stdlib/source/library/lux/macro/syntax/definition.lux b/stdlib/source/library/lux/macro/syntax/definition.lux index 1e309a306..7f9e9583f 100644 --- a/stdlib/source/library/lux/macro/syntax/definition.lux +++ b/stdlib/source/library/lux/macro/syntax/definition.lux @@ -47,21 +47,21 @@ (def: extension "lux def") -(def: (format_tag [module short]) +(def: (tag_format [module short]) (-> Name Code) (` [(~ (code.text module)) (~ (code.text short))])) -(def: (format_annotations value) +(def: (annotations_format value) (-> Annotations Code) (case value #.Nil (` #.Nil) (#.Cons [name value] tail) - (` (#.Cons [(~ (..format_tag name)) + (` (#.Cons [(~ (..tag_format name)) (~ value)] - (~ (format_annotations tail)))))) + (~ (annotations_format tail)))))) (def: dummy Code @@ -79,7 +79,7 @@ (#.Right value) value)) - [(~ ..dummy) (#.Record (~ (..format_annotations anns)))] + [(~ ..dummy) (#.Record (~ (..annotations_format anns)))] (~ (code.bit export?))))) (def: tag_parser diff --git a/stdlib/source/library/lux/macro/template.lux b/stdlib/source/library/lux/macro/template.lux index 36edd6a1e..c835b8fd9 100644 --- a/stdlib/source/library/lux/macro/template.lux +++ b/stdlib/source/library/lux/macro/template.lux @@ -38,7 +38,7 @@ [g!locals (|> locals (list\map //.gensym) (monad.seq !))] - (wrap (list (` (.with_expansions [(~+ (|> (list.zip/2 locals g!locals) + (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))] @@ -145,7 +145,7 @@ inputs_amount (list.size inputs)] (if (nat.= parameters_amount inputs_amount) (.let [environment (: Environment - (|> (list.zip/2 parameters inputs) + (|> (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])))))) diff --git a/stdlib/source/library/lux/math/number/ratio.lux b/stdlib/source/library/lux/math/number/ratio.lux index ecfdf30a0..ca122b00d 100644 --- a/stdlib/source/library/lux/math/number/ratio.lux +++ b/stdlib/source/library/lux/math/number/ratio.lux @@ -33,7 +33,7 @@ 1 (#.Some (get@ #numerator value)) _ #.None)) -(def: (normalize (^slots [#numerator #denominator])) +(def: (normal (^slots [#numerator #denominator])) (-> Ratio Ratio) (let [common (n.gcd numerator denominator)] {#numerator (n./ common numerator) @@ -42,11 +42,11 @@ (syntax: #export (ratio numerator {?denominator (<>.maybe <code>.any)}) {#.doc (doc "Rational literals." (ratio numerator denominator) - "The denominator can be omitted if it's 1." + "The denominator can be omitted if it is 1." (ratio numerator))} - (wrap (list (` ((~! ..normalize) {#..numerator (~ numerator) - #..denominator (~ (maybe.default (' 1) - ?denominator))}))))) + (wrap (list (` ((~! ..normal) {#..numerator (~ numerator) + #..denominator (~ (maybe.default (' 1) + ?denominator))}))))) (def: #export (= parameter subject) (-> Ratio Ratio Bit) @@ -60,7 +60,7 @@ (def: = ..=)) -(def: (equalize parameter subject) +(def: (equalized parameter subject) (-> Ratio Ratio [Nat Nat]) [(n.* (get@ #denominator subject) (get@ #numerator parameter)) @@ -69,7 +69,7 @@ (def: #export (< parameter subject) (-> Ratio Ratio Bit) - (let [[parameter' subject'] (..equalize parameter subject)] + (let [[parameter' subject'] (..equalized parameter subject)] (n.< parameter' subject'))) (def: #export (<= parameter subject) @@ -94,33 +94,33 @@ (def: #export (+ parameter subject) (-> Ratio Ratio Ratio) - (let [[parameter' subject'] (..equalize parameter subject)] - (normalize [(n.+ parameter' subject') - (n.* (get@ #denominator parameter) - (get@ #denominator subject))]))) + (let [[parameter' subject'] (..equalized parameter subject)] + (normal [(n.+ parameter' subject') + (n.* (get@ #denominator parameter) + (get@ #denominator subject))]))) (def: #export (- parameter subject) (-> Ratio Ratio Ratio) - (let [[parameter' subject'] (..equalize parameter subject)] - (normalize [(n.- parameter' subject') - (n.* (get@ #denominator parameter) - (get@ #denominator subject))]))) + (let [[parameter' subject'] (..equalized parameter subject)] + (normal [(n.- parameter' subject') + (n.* (get@ #denominator parameter) + (get@ #denominator subject))]))) (def: #export (* parameter subject) (-> Ratio Ratio Ratio) - (normalize [(n.* (get@ #numerator parameter) - (get@ #numerator subject)) - (n.* (get@ #denominator parameter) - (get@ #denominator subject))])) + (normal [(n.* (get@ #numerator parameter) + (get@ #numerator subject)) + (n.* (get@ #denominator parameter) + (get@ #denominator subject))])) (def: #export (/ parameter subject) (-> Ratio Ratio Ratio) - (let [[parameter' subject'] (..equalize parameter subject)] - (normalize [subject' parameter']))) + (let [[parameter' subject'] (..equalized parameter subject)] + (normal [subject' parameter']))) (def: #export (% parameter subject) (-> Ratio Ratio Ratio) - (let [[parameter' subject'] (..equalize parameter subject) + (let [[parameter' subject'] (..equalized parameter subject) quot (n./ parameter' subject')] (..- (update@ #numerator (n.* quot) parameter) subject))) @@ -144,8 +144,8 @@ (do try.monad [numerator (n\decode num) denominator (n\decode denom)] - (wrap (normalize {#numerator numerator - #denominator denominator}))) + (wrap (normal {#numerator numerator + #denominator denominator}))) #.None (#.Left (text\compose "Invalid syntax for ratio: " input))))) diff --git a/stdlib/source/library/lux/meta.lux b/stdlib/source/library/lux/meta.lux index 5415b7c9e..97cfe8c9e 100644 --- a/stdlib/source/library/lux/meta.lux +++ b/stdlib/source/library/lux/meta.lux @@ -109,7 +109,7 @@ (#try.Success [compiler []]) (#try.Failure message)))) -(def: #export (fail error) +(def: #export (failure error) {#.doc "Fails with the given error message."} (All [a] (-> Text (Meta a))) @@ -152,7 +152,7 @@ _ false))) -(def: #export (normalize name) +(def: #export (normal name) {#.doc (doc "If given a name without a module prefix, gives it the current module's name as prefix." "Otherwise, returns the name as-is.")} (-> Name (Meta Name)) @@ -186,7 +186,7 @@ (def: #export (find_macro full_name) (-> Name (Meta (Maybe Macro))) (do ..monad - [[module name] (normalize full_name)] + [[module name] (..normal full_name)] (: (Meta (Maybe Macro)) (function (_ compiler) (let [macro (case (..current_module_name compiler) @@ -277,7 +277,7 @@ {#.doc "Looks-up a definition's whole data in the available modules (including the current one)."} (-> Name (Meta Global)) (do ..monad - [name (normalize name) + [name (..normal name) #let [[normal_module normal_short] name]] (function (_ compiler) (case (: (Maybe Global) @@ -337,15 +337,15 @@ [definition (..find_def name)] (case definition (#.Left de_aliased) - (fail ($_ text\compose - "Aliases are not considered exports: " - (name\encode name))) + (failure ($_ text\compose + "Aliases are not considered exports: " + (name\encode name))) (#.Right definition) (let [[exported? def_type def_data def_value] definition] (if exported? (wrap definition) - (fail ($_ text\compose "Definition is not an export: " (name\encode name)))))))) + (failure ($_ text\compose "Definition is not an export: " (name\encode name)))))))) (def: #export (find_def_type name) {#.doc "Looks-up a definition's type in the available modules (including the current one)."} @@ -388,7 +388,7 @@ (type_to_code .Type) (type_to_code def_type))) (wrap (:as Type def_value)) - (..fail ($_ text\compose "Definition is not a type: " (name\encode name)))))))) + (..failure ($_ text\compose "Definition is not a type: " (name\encode name)))))))) (def: #export (globals module) {#.doc "The entire list of globals in a module (including the non-exported/private ones)."} @@ -496,16 +496,16 @@ (if (or (text\= this_module_name module) (and imported! exported?)) (wrap [idx tag_list type]) - (..fail ($_ text\compose "Cannot access tag: " (name\encode tag) " from module " this_module_name))) + (..failure ($_ text\compose "Cannot access tag: " (name\encode tag) " from module " this_module_name))) _ - (..fail ($_ text\compose - "Unknown tag: " (name\encode tag) text.new_line - " Known tags: " (|> =module - (get@ #.tags) - (list\map (|>> product.left [module] name\encode (text.prefix text.new_line))) - (text.join_with "")) - ))))) + (..failure ($_ text\compose + "Unknown tag: " (name\encode tag) text.new_line + " Known tags: " (|> =module + (get@ #.tags) + (list\map (|>> product.left [module] name\encode (text.prefix text.new_line))) + (text.join_with "")) + ))))) (def: #export (tag_lists module) {#.doc "All the tag-lists defined in a module, with their associated types."} @@ -565,4 +565,4 @@ (\ ..monad wrap output) (#try.Failure error) - (..fail error))) + (..failure error))) diff --git a/stdlib/source/library/lux/target/common_lisp.lux b/stdlib/source/library/lux/target/common_lisp.lux index 2ebcb6a8e..a83162d28 100644 --- a/stdlib/source/library/lux/target/common_lisp.lux +++ b/stdlib/source/library/lux/target/common_lisp.lux @@ -115,7 +115,7 @@ (text.replace_once "E" "d" raw) (format raw "d0")))))) - (def: sanitize + (def: safe (-> Text Text) (`` (|>> (~~ (template [<find> <replace>] [(text.replace_all <find> <replace>)] @@ -134,7 +134,7 @@ (def: #export string (-> Text Literal) - (|>> ..sanitize + (|>> ..safe (text.enclose' text.double_quote) :abstraction)) diff --git a/stdlib/source/library/lux/target/js.lux b/stdlib/source/library/lux/target/js.lux index 26c2e7b41..d19bb0b8b 100644 --- a/stdlib/source/library/lux/target/js.lux +++ b/stdlib/source/library/lux/target/js.lux @@ -84,7 +84,7 @@ ## else (|> value %.frac ..expression)))) - (def: sanitize + (def: safe (-> Text Text) (`` (|>> (~~ (template [<replace> <find>] [(text.replace_all <find> <replace>)] @@ -104,7 +104,7 @@ (def: #export string (-> Text Literal) - (|>> ..sanitize + (|>> ..safe (text.enclose [text.double_quote text.double_quote]) :abstraction)) diff --git a/stdlib/source/library/lux/target/jvm/bytecode.lux b/stdlib/source/library/lux/target/jvm/bytecode.lux index 0d94ae9f1..ba09af5bb 100644 --- a/stdlib/source/library/lux/target/jvm/bytecode.lux +++ b/stdlib/source/library/lux/target/jvm/bytecode.lux @@ -162,13 +162,13 @@ (: (Monad Try)) try.monad)) -(def: #export fail +(def: #export failure (-> Text Bytecode) (|>> #try.Failure function.constant)) (def: #export (throw exception value) (All [e] (-> (exception.Exception e) e Bytecode)) - (..fail (exception.construct exception value))) + (..failure (exception.construct exception value))) (def: #export (resolve environment bytecode) (All [a] (-> Environment (Bytecode a) (Resource [Environment (Row Exception) Instruction a]))) @@ -907,7 +907,7 @@ [>default (\ ! map ..big_jump (..jump @from @default)) >cases (|> @cases (monad.map ! (|>> (..jump @from) (\ ! map ..big_jump))) - (\ ! map (|>> (list.zip/2 (list\map product.left cases)))))] + (\ ! map (|>> (list.zipped/2 (list\map product.left cases)))))] (wrap [..no_exceptions (bytecode >default >cases)])) #.None diff --git a/stdlib/source/library/lux/target/jvm/encoding/name.lux b/stdlib/source/library/lux/target/jvm/encoding/name.lux index 5a1982d3e..02507ceb6 100644 --- a/stdlib/source/library/lux/target/jvm/encoding/name.lux +++ b/stdlib/source/library/lux/target/jvm/encoding/name.lux @@ -31,10 +31,10 @@ (text.replace_all ..internal_separator ..external_separator)))) -(def: #export sanitize +(def: #export safe (-> Text External) (|>> ..internal ..external)) (def: #export (qualify package class) (-> Text External External) - (format (..sanitize package) ..external_separator class)) + (format (..safe package) ..external_separator class)) diff --git a/stdlib/source/library/lux/target/jvm/reflection.lux b/stdlib/source/library/lux/target/jvm/reflection.lux index 50bb2b974..5745ecd89 100644 --- a/stdlib/source/library/lux/target/jvm/reflection.lux +++ b/stdlib/source/library/lux/target/jvm/reflection.lux @@ -303,8 +303,8 @@ (if (text\= class_name name) (if (n.= num_class_params num_type_params) (|> params - (list.zip/2 (list\map (|>> java/lang/reflect/TypeVariable::getName) - class_params)) + (list.zipped/2 (list\map (|>> java/lang/reflect/TypeVariable::getName) + class_params)) (list\fold (function (_ [name paramT] mapping) (dictionary.put name paramT mapping)) /lux.fresh) diff --git a/stdlib/source/library/lux/target/jvm/type/lux.lux b/stdlib/source/library/lux/target/jvm/type/lux.lux index b4abe4093..ea9df2259 100644 --- a/stdlib/source/library/lux/target/jvm/type/lux.lux +++ b/stdlib/source/library/lux/target/jvm/type/lux.lux @@ -233,4 +233,4 @@ check (#try.Failure error) - (check.fail error))) + (check.failure error))) diff --git a/stdlib/source/library/lux/target/lua.lux b/stdlib/source/library/lux/target/lua.lux index 11f2c285e..3c76ad6c4 100644 --- a/stdlib/source/library/lux/target/lua.lux +++ b/stdlib/source/library/lux/target/lua.lux @@ -115,7 +115,7 @@ [%.frac (text.replace_all "+" "")]) :abstraction)) - (def: sanitize + (def: safe (-> Text Text) (`` (|>> (~~ (template [<find> <replace>] [(text.replace_all <find> <replace>)] @@ -134,7 +134,7 @@ (def: #export string (-> Text Literal) - (|>> ..sanitize (text.enclose' text.double_quote) :abstraction)) + (|>> ..safe (text.enclose' text.double_quote) :abstraction)) (def: #export multi (-> (List Expression) Literal) diff --git a/stdlib/source/library/lux/target/php.lux b/stdlib/source/library/lux/target/php.lux index 5008eae43..5ca2e0d58 100644 --- a/stdlib/source/library/lux/target/php.lux +++ b/stdlib/source/library/lux/target/php.lux @@ -155,7 +155,7 @@ [%.frac]) :abstraction)) - (def: sanitize + (def: safe (-> Text Text) (`` (|>> (~~ (template [<find> <replace>] [(text.replace_all <find> <replace>)] @@ -175,7 +175,7 @@ (def: #export string (-> Text Literal) - (|>> ..sanitize + (|>> ..safe (text.enclose [text.double_quote text.double_quote]) :abstraction)) diff --git a/stdlib/source/library/lux/target/python.lux b/stdlib/source/library/lux/target/python.lux index 0cf6d2c27..3c8450b31 100644 --- a/stdlib/source/library/lux/target/python.lux +++ b/stdlib/source/library/lux/target/python.lux @@ -150,7 +150,7 @@ [%.frac]) :abstraction))) - (def: sanitize + (def: safe (-> Text Text) (`` (|>> (~~ (template [<find> <replace>] [(text.replace_all <find> <replace>)] @@ -169,7 +169,7 @@ (def: #export string (-> Text Literal) - (|>> ..sanitize + (|>> ..safe (text.enclose [text.double_quote text.double_quote]) :abstraction)) @@ -444,7 +444,7 @@ (def: #export (comment commentary on) (All [brand] (-> Text (Code brand) (Code brand))) - (:abstraction (format "# " (..sanitize commentary) text.new_line + (:abstraction (format "# " (..safe commentary) text.new_line (:representation on)))) ) diff --git a/stdlib/source/library/lux/target/r.lux b/stdlib/source/library/lux/target/r.lux index 06f516e75..f6180c45c 100644 --- a/stdlib/source/library/lux/target/r.lux +++ b/stdlib/source/library/lux/target/r.lux @@ -133,7 +133,7 @@ [%.frac]) ..self_contained)) - (def: sanitize + (def: safe (-> Text Text) (`` (|>> (~~ (template [<find> <replace>] [(text.replace_all <find> <replace>)] @@ -151,7 +151,7 @@ (def: #export string (-> Text Expression) - (|>> ..sanitize %.text :abstraction)) + (|>> ..safe %.text :abstraction)) (def: #export (slice from to list) (-> Expression Expression Expression Expression) diff --git a/stdlib/source/library/lux/target/ruby.lux b/stdlib/source/library/lux/target/ruby.lux index a7dd6907f..1d28af979 100644 --- a/stdlib/source/library/lux/target/ruby.lux +++ b/stdlib/source/library/lux/target/ruby.lux @@ -147,7 +147,7 @@ #1 "true") :abstraction)) - (def: sanitize + (def: safe (-> Text Text) (`` (|>> (~~ (template [<find> <replace>] [(text.replace_all <find> <replace>)] @@ -170,7 +170,7 @@ (|>> <prep> <format> :abstraction))] [%.int int Int (<|)] - [%.text string Text ..sanitize] + [%.text string Text ..safe] [(<|) symbol Text (format ":")] ) @@ -416,7 +416,7 @@ (def: #export (comment commentary on) (All [brand] (-> Text (Code brand) (Code brand))) - (:abstraction (format "# " (..sanitize commentary) text.new_line + (:abstraction (format "# " (..safe commentary) text.new_line (:representation on)))) ) diff --git a/stdlib/source/library/lux/target/scheme.lux b/stdlib/source/library/lux/target/scheme.lux index 43b94d459..6ebc254db 100644 --- a/stdlib/source/library/lux/target/scheme.lux +++ b/stdlib/source/library/lux/target/scheme.lux @@ -128,7 +128,7 @@ (def: #export negative_infinity Computation (..float f.negative_infinity)) (def: #export not_a_number Computation (..float f.not_a_number)) - (def: sanitize + (def: safe (-> Text Text) (`` (|>> (~~ (template [<find> <replace>] [(text.replace_all <find> <replace>)] @@ -146,7 +146,7 @@ (def: #export string (-> Text Computation) - (|>> ..sanitize %.text :abstraction)) + (|>> ..safe %.text :abstraction)) (def: #export symbol (-> Text Computation) diff --git a/stdlib/source/library/lux/test.lux b/stdlib/source/library/lux/test.lux index e14505e13..c3c67ff82 100644 --- a/stdlib/source/library/lux/test.lux +++ b/stdlib/source/library/lux/test.lux @@ -12,7 +12,7 @@ ["." io] [concurrency ["." atom (#+ Atom)] - ["." promise (#+ Promise) ("#\." monad)]] + ["." async (#+ Async) ("#\." monad)]] ["<>" parser ["<.>" code]]] [data @@ -67,12 +67,12 @@ Tally (update@ <category> .inc ..start))] - [success #successes] - [failure #failures] + [success_tally #successes] + [failure_tally #failures] ) (type: #export Assertion - (Promise [Tally Text])) + (Async [Tally Text])) (type: #export Test (Random Assertion)) @@ -83,15 +83,15 @@ (def: #export (and' left right) {#.doc "Sequencing combinator."} (-> Assertion Assertion Assertion) - (let [[read! write!] (: [(Promise [Tally Text]) - (promise.Resolver [Tally Text])] - (promise.promise [])) + (let [[read! write!] (: [(Async [Tally Text]) + (async.Resolver [Tally Text])] + (async.async [])) _ (|> left - (promise.await (function (_ [l_tally l_documentation]) - (promise.await (function (_ [r_tally r_documentation]) - (write! [(add_tally l_tally r_tally) - (format l_documentation ..separator r_documentation)])) - right))) + (async.await (function (_ [l_tally l_documentation]) + (async.await (function (_ [r_tally r_documentation]) + (write! [(add_tally l_tally r_tally) + (format l_documentation ..separator r_documentation)])) + right))) io.run)] read!)) @@ -107,30 +107,30 @@ (def: #export (context description) (-> Text Test Test) - (random\map (promise\map (function (_ [tally documentation]) - [tally (|> documentation - (text.split_all_with ..separator) - (list\map (|>> (format context_prefix))) - (text.join_with ..separator) - (format description ..separator))])))) + (random\map (async\map (function (_ [tally documentation]) + [tally (|> documentation + (text.split_all_with ..separator) + (list\map (|>> (format context_prefix))) + (text.join_with ..separator) + (format description ..separator))])))) (def: failure_prefix "[Failure] ") (def: success_prefix "[Success] ") -(def: #export fail +(def: #export failure (-> Text Test) (|>> (format ..failure_prefix) - [..failure] - promise\wrap + [..failure_tally] + async\wrap random\wrap)) (def: #export (assert message condition) {#.doc "Check that a condition is #1, and fail with the given message otherwise."} (-> Text Bit Assertion) - (<| promise\wrap + (<| async\wrap (if condition - [..success (format ..success_prefix message)] - [..failure (format ..failure_prefix message)]))) + [..success_tally (format ..success_prefix message)] + [..failure_tally (format ..failure_prefix message)]))) (def: #export (test message condition) {#.doc "Check that a condition is #1, and fail with the given message otherwise."} @@ -170,12 +170,12 @@ (def: #export (times amount test) (-> Nat Test Test) (case amount - 0 (..fail (exception.construct ..must_try_test_at_least_once [])) + 0 (..failure (exception.construct ..must_try_test_at_least_once [])) _ (do random.monad [seed random.nat] (function (recur prng) (let [[prng' instance] (random.run (random.pcg32 [..pcg32_magic_inc seed]) test)] - [prng' (do {! promise.monad} + [prng' (do {! async.monad} [[tally documentation] instance] (if (..failed? tally) (wrap [tally (times_failure seed documentation)]) @@ -240,21 +240,21 @@ (def: success_exit_code +0) (def: #export (run! test) - (-> Test (Promise Nothing)) - (do promise.monad - [pre (promise.future instant.now) + (-> Test (Async Nothing)) + (do async.monad + [pre (async.future instant.now) #let [seed (instant.to_millis pre) prng (random.pcg32 [..pcg32_magic_inc seed])] [tally documentation] (|> test (random.run prng) product.right) - post (promise.future instant.now) + post (async.future instant.now) #let [duration (instant.span pre post) _ (debug.log! (format documentation text.new_line text.new_line (..description duration tally) text.new_line))]] - (promise.future (\ program.default exit - (case (get@ #failures tally) - 0 ..success_exit_code - _ ..failure_exit_code))))) + (async.future (\ program.default exit + (case (get@ #failures tally) + 0 ..success_exit_code + _ ..failure_exit_code))))) (def: (|cover'| coverage condition) (-> (List Name) Bit Assertion) @@ -263,9 +263,9 @@ (text.join_with " & ")) coverage (set.of_list name.hash coverage)] (|> (..assert message condition) - (promise\map (function (_ [tally documentation]) - [(update@ #actual_coverage (set.union coverage) tally) - documentation]))))) + (async\map (function (_ [tally documentation]) + [(update@ #actual_coverage (set.union coverage) tally) + documentation]))))) (def: (|cover| coverage condition) (-> (List Name) Bit Test) @@ -278,9 +278,9 @@ (list\map %.name) (text.join_with " & ")) coverage (set.of_list name.hash coverage)] - (random\map (promise\map (function (_ [tally documentation]) - [(update@ #actual_coverage (set.union coverage) tally) - documentation])) + (random\map (async\map (function (_ [tally documentation]) + [(update@ #actual_coverage (set.union coverage) tally) + documentation])) (..context context test)))) (def: (name_code name) @@ -345,9 +345,9 @@ (-> Text Text Test Test) (let [coverage (..decode_coverage module coverage)] (|> (..context module test) - (random\map (promise\map (function (_ [tally documentation]) - [(update@ #expected_coverage (set.union coverage) tally) - documentation])))))) + (random\map (async\map (function (_ [tally documentation]) + [(update@ #expected_coverage (set.union coverage) tally) + documentation])))))) (syntax: #export (covering {module <code>.identifier} test) @@ -374,7 +374,7 @@ (-> (List Test) Test) (case (list.size tests) 0 - (random\wrap (promise\wrap [..start ""])) + (random\wrap (async\wrap [..start ""])) expected_tests (do random.monad @@ -391,29 +391,29 @@ (#try.Failure error) (..assert (exception.construct ..error_during_execution [error]) false)) io.io - promise.future - promise\join)) + async.future + async\join)) state (: (Atom (Dictionary Nat [Tally Text])) (atom.atom (dictionary.new n.order))) [read! write!] (: [Assertion - (promise.Resolver [Tally Text])] - (promise.promise [])) + (async.Resolver [Tally Text])] + (async.async [])) _ (io.run (monad.map io.monad (function (_ [index test]) - (promise.await (function (_ assertion) - (do io.monad - [[_ results] (atom.update (dictionary.put index assertion) state)] - (if (n.= expected_tests (dictionary.size results)) - (let [assertions (|> results - dictionary.entries - (list\map product.right))] - (write! [(|> assertions - (list\map product.left) - (list\fold ..add_tally ..start)) - (|> assertions - (list\map product.right) - (text.join_with ..separator))])) - (wrap [])))) - (run! test))) + (async.await (function (_ assertion) + (do io.monad + [[_ results] (atom.update (dictionary.put index assertion) state)] + (if (n.= expected_tests (dictionary.size results)) + (let [assertions (|> results + dictionary.entries + (list\map product.right))] + (write! [(|> assertions + (list\map product.left) + (list\fold ..add_tally ..start)) + (|> assertions + (list\map product.right) + (text.join_with ..separator))])) + (wrap [])))) + (run! test))) (list.enumeration tests)))]] (wrap read!)))) diff --git a/stdlib/source/library/lux/tool/compiler/default/platform.lux b/stdlib/source/library/lux/tool/compiler/default/platform.lux index 2e5fb6fed..c60700019 100644 --- a/stdlib/source/library/lux/tool/compiler/default/platform.lux +++ b/stdlib/source/library/lux/tool/compiler/default/platform.lux @@ -11,7 +11,7 @@ ["." try (#+ Try) ("#\." functor)] ["." exception (#+ exception:)] [concurrency - ["." promise (#+ Promise Resolver) ("#\." monad)] + ["." async (#+ Async Resolver) ("#\." monad)] ["." stm (#+ Var STM)]]] [data ["." binary (#+ Binary)] @@ -68,7 +68,7 @@ (All [s i o] (-> (Phase s i o) Any))) (type: #export (Platform <type_vars>) - {#&file_system (file.System Promise) + {#&file_system (file.System Async) #host (///generation.Host expression directive) #phase (///generation.Phase <type_vars>) #runtime (<Operation> [Registry Output]) @@ -77,12 +77,12 @@ ## TODO: Get rid of this (type: (Action a) - (Promise (Try a))) + (Async (Try a))) ## TODO: Get rid of this (def: monad (:as (Monad Action) - (try.with promise.monad))) + (try.with async.monad))) (with_expansions [<Platform> (as_is (Platform <type_vars>)) <State+> (as_is (///directive.State+ <type_vars>)) @@ -96,7 +96,7 @@ (def: (cache_module static platform module_id [descriptor document output]) (All [<type_vars>] (-> Static <Platform> archive.ID [Descriptor (Document Any) Output] - (Promise (Try Any)))) + (Async (Try Any)))) (let [system (get@ #&file_system platform) write_artifact! (: (-> [artifact.ID (Maybe Text) Binary] (Action Any)) (function (_ [artifact_id custom content]) @@ -112,7 +112,7 @@ row.to_list (monad.map ..monad write_artifact!) (: (Action (List Any))))) - document (\ promise.monad wrap + document (\ async.monad wrap (document.check $.key document))] (ioW.cache system static module_id (_.run ..writer [descriptor document]))))) @@ -234,8 +234,8 @@ (Program expression directive) [Type Type Type] (-> Phase_Wrapper Extender) Import (List Context) - (Promise (Try [<State+> Archive])))) - (do {! (try.with promise.monad)} + (Async (Try [<State+> Archive])))) + (do {! (try.with async.monad)} [#let [state (//init.state (get@ #static.host static) module expander @@ -247,9 +247,9 @@ [archive analysis_state bundles] (ioW.thaw (get@ #host platform) (get@ #&file_system platform) static import compilation_sources) #let [with_missing_extensions (: (All [<type_vars>] - (-> <Platform> (Program expression directive) <State+> (Promise (Try <State+>)))) + (-> <Platform> (Program expression directive) <State+> (Async (Try <State+>)))) (function (_ platform program state) - (promise\wrap + (async\wrap (do try.monad [[state phase_wrapper] (..phase_wrapper archive platform state)] (|> state @@ -264,7 +264,7 @@ (do ! [[state [archive payload]] (|> (..process_runtime archive platform) (///phase.run' state) - promise\wrap) + async\wrap) _ (..cache_module static platform 0 payload) state (with_missing_extensions platform program state)] @@ -379,7 +379,7 @@ (with_expansions [<Context> (as_is [Archive <State+>]) <Result> (as_is (Try <Context>)) - <Return> (as_is (Promise <Result>)) + <Return> (as_is (Async <Result>)) <Signal> (as_is (Resolver <Result>)) <Pending> (as_is [<Return> <Signal>]) <Importer> (as_is (-> Module Module <Return>)) @@ -399,14 +399,14 @@ (stm.var ..independence))] (function (_ compile) (function (import! importer module) - (do {! promise.monad} + (do {! async.monad} [[return signal] (:sharing [<type_vars>] <Context> initial - (Promise [<Return> (Maybe [<Context> - archive.ID - <Signal>])]) + (Async [<Return> (Maybe [<Context> + archive.ID + <Signal>])]) (:assume (stm.commit (do {! stm.monad} @@ -417,14 +417,14 @@ (wrap dependence)))] (case (..verify_dependencies importer module dependence) (#try.Failure error) - (wrap [(promise.resolved (#try.Failure error)) + (wrap [(async.resolved (#try.Failure error)) #.None]) (#try.Success _) (do ! [[archive state] (stm.read current)] (if (archive.archived? archive module) - (wrap [(promise\wrap (#try.Success [archive state])) + (wrap [(async\wrap (#try.Success [archive state])) #.None]) (do ! [@pending (stm.read pending)] @@ -447,7 +447,7 @@ initial <Pending> - (promise.promise []))] + (async.async []))] _ (stm.update (dictionary.put module [return signal]) pending)] (wrap [return (#.Some [[archive state] @@ -455,7 +455,7 @@ signal])])) (#try.Failure error) - (wrap [(promise\wrap (#try.Failure error)) + (wrap [(async\wrap (#try.Failure error)) #.None]))))))))))) _ (case signal #.None @@ -475,7 +475,7 @@ state]) current)] (wrap (#try.Success [merged_archive resulting_state]))))) - _ (promise.future (resolver result))] + _ (async.future (resolver result))] (wrap [])))] return))))) @@ -531,7 +531,7 @@ compiler (..parallel context (function (_ importer import! module_id [archive state] module) - (do {! (try.with promise.monad)} + (do {! (try.with async.monad)} [#let [state (..set_current_module module state)] input (context.read (get@ #&file_system platform) importer @@ -592,11 +592,11 @@ (..with_reset_log state)]) (#try.Failure error) - (promise\wrap (#try.Failure error))))) + (async\wrap (#try.Failure error))))) (#try.Failure error) (do ! [_ (ioW.freeze (get@ #&file_system platform) static archive)] - (promise\wrap (#try.Failure error))))))))))] + (async\wrap (#try.Failure error))))))))))] (compiler archive.runtime_module compilation_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 c29eaaf54..0fc5d90fc 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/analysis.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis.lux @@ -464,14 +464,14 @@ (format (%.location location) text.new_line error)) -(def: #export (fail error) +(def: #export (failure error) (-> Text Operation) (function (_ [bundle state]) (#try.Failure (locate_error (get@ #.location state) error)))) (def: #export (throw exception parameters) (All [e] (-> (Exception e) e Operation)) - (..fail (exception.construct exception parameters))) + (..failure (exception.construct exception parameters))) (def: #export (assert exception parameters condition) (All [e] (-> (Exception e) e Bit (Operation Any))) @@ -479,14 +479,14 @@ (\ phase.monad wrap []) (..throw exception parameters))) -(def: #export (fail' error) +(def: #export (failure' error) (-> Text (phase.Operation Lux)) (function (_ state) (#try.Failure (locate_error (get@ #.location state) error)))) (def: #export (throw' exception parameters) (All [e] (-> (Exception e) e (phase.Operation Lux))) - (..fail' (exception.construct exception parameters))) + (..failure' (exception.construct exception parameters))) (def: #export (with_stack exception message action) (All [e o] (-> (Exception e) e (Operation o) (Operation o))) 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 d0957820c..f8f295429 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 @@ -38,7 +38,7 @@ (#try.Success output) (#try.Failure error) - ((meta.fail (exception.construct ..expansion_failed [name inputs error])) state))))) + ((meta.failure (exception.construct ..expansion_failed [name inputs error])) state))))) (def: #export (expand_one expander name macro inputs) (-> Expander Name Macro (List Code) (Meta Code)) @@ -49,4 +49,4 @@ (wrap single) _ - (meta.fail (exception.construct ..must_have_single_expansion [name inputs expansion]))))) + (meta.failure (exception.construct ..must_have_single_expansion [name inputs expansion]))))) 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 327488817..54e4e90d6 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 @@ -199,14 +199,14 @@ num_sub_patterns (list.size sub_patterns) matches (cond (n.< num_subs num_sub_patterns) (let [[prefix suffix] (list.split (dec num_sub_patterns) subs)] - (list.zip/2 (list\compose prefix (list (type.tuple suffix))) sub_patterns)) + (list.zipped/2 (list\compose prefix (list (type.tuple suffix))) sub_patterns)) (n.> num_subs num_sub_patterns) (let [[prefix suffix] (list.split (dec num_subs) sub_patterns)] - (list.zip/2 subs (list\compose prefix (list (code.tuple suffix))))) + (list.zipped/2 subs (list\compose prefix (list (code.tuple suffix))))) ## (n.= num_subs num_sub_patterns) - (list.zip/2 subs sub_patterns))] + (list.zipped/2 subs sub_patterns))] (do ! [[memberP+ thenA] (list\fold (: (All [a] (-> [Type Code] (Operation [(List Pattern) a]) @@ -230,7 +230,7 @@ [location (#.Record record)] (do ///.monad - [record (//structure.normalize record) + [record (//structure.normal record) [members recordT] (//structure.order record) _ (.case inputT (#.Var _id) @@ -287,7 +287,7 @@ (^ [location (#.Form (list& [_ (#.Tag tag)] values))]) (/.with_location location (do ///.monad - [tag (///extension.lift (meta.normalize tag)) + [tag (///extension.lift (meta.normal tag)) [idx group variantT] (///extension.lift (meta.resolve_tag tag)) _ (//type.with_env (check.check inputT variantT)) @@ -318,7 +318,7 @@ (/coverage.exhaustive? coverage)) (#try.Failure error) - (/.fail error))] + (/.failure error))] (wrap (#/.Case inputA [outputH outputT]))) #.Nil 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 bc4fad3d3..2bb0fe957 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 @@ -202,7 +202,7 @@ (and (n.= (list.size flatR) (list.size flatS)) (list.every? (function (_ [coverageR coverageS]) (= coverageR coverageS)) - (list.zip/2 flatR flatS)))) + (list.zipped/2 flatR flatS)))) _ #0))) @@ -344,7 +344,7 @@ (wrap [(#.Some altMSF) altsSF'])) (#try.Failure error) - (try.fail error)) + (try.failure error)) ))))] [successA possibilitiesSF] (fuse_once addition (flat_alt so_far))] (loop [successA successA 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 5e41e907e..1ef5c88c4 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 @@ -58,7 +58,7 @@ (recur value) #.None - (/.fail (ex.construct cannot_analyse [expectedT function_name arg_name body]))) + (/.failure (ex.construct cannot_analyse [expectedT function_name arg_name body]))) (^template [<tag> <instancer>] [(<tag> _) @@ -102,7 +102,7 @@ (analyse archive body)) _ - (/.fail "") + (/.failure "") ))))) (def: #export (apply analyse argsC+ functionT functionA archive functionC) 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 9ce2b1faa..4e085a6b9 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 @@ -41,7 +41,7 @@ (#.Right [exported? actualT def_anns _]) (do ! [_ (//type.infer actualT) - (^@ def_name [::module ::name]) (///extension.lift (meta.normalize def_name)) + (^@ def_name [::module ::name]) (///extension.lift (meta.normal def_name)) current (///extension.lift meta.current_module_name)] (if (text\= current ::module) <return> 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 c49e936ec..ca42337d5 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 @@ -262,7 +262,7 @@ (def: #export (tagged_sum analyse tag archive valueC) (-> Phase Name Phase) (do {! ///.monad} - [tag (///extension.lift (meta.normalize tag)) + [tag (///extension.lift (meta.normal tag)) [idx group variantT] (///extension.lift (meta.resolve_tag tag)) #let [case_size (list.size group) [lefts right?] (/.choice case_size idx)] @@ -281,14 +281,14 @@ ## records, so they must be normalized for further analysis. ## Normalization just means that all the tags get resolved to their ## canonical form (with their corresponding module identified). -(def: #export (normalize record) +(def: #export (normal record) (-> (List [Code Code]) (Operation (List [Name Code]))) (monad.map ///.monad (function (_ [key val]) (case key [_ (#.Tag key)] (do ///.monad - [key (///extension.lift (meta.normalize key))] + [key (///extension.lift (meta.normal key))] (wrap [key val])) _ @@ -307,7 +307,7 @@ (#.Cons [head_k head_v] _) (do {! ///.monad} - [head_k (///extension.lift (meta.normalize head_k)) + [head_k (///extension.lift (meta.normal head_k)) [_ tag_set recordT] (///extension.lift (meta.resolve_tag head_k)) #let [size_record (list.size record) size_ts (list.size tag_set)] @@ -315,11 +315,11 @@ (wrap []) (/.throw ..record_size_mismatch [size_ts size_record recordT record])) #let [tuple_range (list.indices size_ts) - tag->idx (dictionary.of_list name.hash (list.zip/2 tag_set tuple_range))] + tag->idx (dictionary.of_list name.hash (list.zipped/2 tag_set tuple_range))] idx->val (monad.fold ! (function (_ [key val] idx->val) (do ! - [key (///extension.lift (meta.normalize key))] + [key (///extension.lift (meta.normal key))] (case (dictionary.get key tag->idx) (#.Some idx) (if (dictionary.key? idx->val idx) @@ -347,7 +347,7 @@ _ (do {! ///.monad} - [members (normalize members) + [members (normal members) [membersC recordT] (order members) expectedT (///extension.lift meta.expected_type)] (case expectedT 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 61948e7c2..c9227aa31 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 @@ -30,7 +30,7 @@ output]) (#try.Failure error) - ((/.fail error) stateE)))) + ((/.failure error) stateE)))) (def: #export with_fresh_env (All [a] (-> (Operation a) (Operation a))) 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 f47ca7aea..bd49944a1 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 @@ -851,7 +851,7 @@ check) (#try.Failure error) - (phase.fail error)))] + (phase.failure error)))] [boxed_reflection_type Value luxT.boxed_type] [reflection_type Value luxT.type] @@ -1123,7 +1123,7 @@ #.None actualJC))))) true - (list.zip/2 parameters inputsJT)))]] + (list.zipped/2 parameters inputsJT)))]] (wrap (and correct_class? correct_method? static_matches? @@ -1153,7 +1153,7 @@ #.None actualJC))))) true - (list.zip/2 parameters inputsJT)))))) + (list.zipped/2 parameters inputsJT)))))) (def: idx_to_parameter (-> Nat .Type) @@ -1278,8 +1278,8 @@ (def: (aliasing expected actual) (-> (List (Type Var)) (List (Type Var)) Aliasing) - (|> (list.zip/2 (list\map jvm_parser.name actual) - (list\map jvm_parser.name expected)) + (|> (list.zipped/2 (list\map jvm_parser.name actual) + (list\map jvm_parser.name expected)) (dictionary.of_list text.hash))) (def: (method_candidate class_loader actual_class_tvars class_name actual_method_tvars method_name method_style inputsJT) @@ -1360,7 +1360,7 @@ (def: (decorate_inputs typesT inputsA) (-> (List (Type Value)) (List Analysis) (List Analysis)) (|> inputsA - (list.zip/2 (list\map (|>> ..signature /////analysis.text) typesT)) + (list.zipped/2 (list\map (|>> ..signature /////analysis.text) typesT)) (list\map (function (_ [type value]) (/////analysis.tuple (list type value)))))) @@ -1917,7 +1917,7 @@ phase.lift)] (|> super_parameters (monad.map ! (..reflection_type mapping)) - (\ ! map (|>> (list.zip/2 parent_parameters))))) + (\ ! map (|>> (list.zipped/2 parent_parameters))))) (phase.lift (exception.throw ..mismatched_super_parameters [parent_name expected_count actual_count])))) #.None @@ -2067,7 +2067,7 @@ _ (phase.assert ..class_parameter_mismatch [expected_parameters actual_parameters] (n.= (list.size expected_parameters) (list.size actual_parameters)))] - (wrap (|> (list.zip/2 expected_parameters actual_parameters) + (wrap (|> (list.zipped/2 expected_parameters actual_parameters) (list\fold (function (_ [expected actual] mapping) (case (jvm_parser.var? actual) (#.Some actual) 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 a5e924af1..2804d568f 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 @@ -59,7 +59,7 @@ (function (_ [argT argC]) (typeA.with_type argT (analyse archive argC))) - (list.zip/2 inputsT+ args))] + (list.zipped/2 inputsT+ args))] (wrap (#////analysis.Extension extension_name argsA))) (////analysis.throw ///.incorrect_arity [extension_name num_expected num_actual])))))) @@ -91,7 +91,7 @@ [raw <code>.text] (case (text.size raw) 1 (wrap (|> raw (text.nth 0) maybe.assume)) - _ (<>.fail (exception.construct ..char_text_must_be_size_1 [raw]))))) + _ (<>.failure (exception.construct ..char_text_must_be_size_1 [raw]))))) (def: lux::syntax_char_case! (..custom 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 079fc96ec..bcab57722 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 @@ -345,7 +345,7 @@ (wrap elementJT) #.None - (<>.fail (exception.construct ..not-an-object-array arrayJT))) + (<>.failure (exception.construct ..not-an-object-array arrayJT))) #.None (undefined)))) @@ -1053,7 +1053,7 @@ bodyS]) (do ! [bodyG (//////generation.with-context artifact-id - (generate archive bodyS))] + (generate archive bodyS))] (wrap (method.method ($_ modifier\compose method.public method.final 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 41e7cda43..4febcca3c 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 @@ -92,7 +92,7 @@ (do {! meta.monad} [ids (monad.seq ! (list.repeat (list.size vars) meta.count))] (wrap (list (` (let [(~+ (|> vars - (list.zip/2 ids) + (list.zipped/2 ids) (list\map (function (_ [id var]) (list (code.local_identifier var) (` (_.var (~ (code.text (format "v" (%.nat id))))))))) 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 bfd952cc9..a4c5ebd10 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 @@ -90,7 +90,7 @@ (do {! meta.monad} [ids (monad.seq ! (list.repeat (list.size vars) meta.count))] (wrap (list (` (let [(~+ (|> vars - (list.zip/2 ids) + (list.zipped/2 ids) (list\map (function (_ [id var]) (list (code.local_identifier var) (` (_.var (~ (code.text (format "v" (%.nat id))))))))) 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 7d2416d67..74cbae5c8 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 @@ -29,22 +29,22 @@ [reference [variable (#+ Register)]]]]]) -(def: equals-name +(def: equals_name "equals") -(def: equals-type +(def: equals_type (type.method [(list //type.value) type.boolean (list)])) -(def: (pop-alt stack-depth) +(def: (pop_alt stack_depth) (-> Nat (Bytecode Any)) - (.case stack-depth + (.case stack_depth 0 (_\wrap []) 1 _.pop 2 _.pop2 _ ## (n.> 2) ($_ _.compose _.pop2 - (pop-alt (n.- 2 stack-depth))))) + (pop_alt (n.- 2 stack_depth))))) (def: int (-> (I64 Any) (Bytecode Any)) @@ -62,15 +62,15 @@ (Bytecode Any) ($_ _.compose _.dup - (//runtime.get //runtime.stack-head))) + (//runtime.get //runtime.stack_head))) (def: pop (Bytecode Any) ($_ _.compose - (//runtime.get //runtime.stack-tail) + (//runtime.get //runtime.stack_tail) (_.checkcast //type.stack))) -(def: (left-projection lefts) +(def: (left_projection lefts) (-> Nat (Bytecode Any)) ($_ _.compose (_.checkcast //type.tuple) @@ -80,16 +80,16 @@ _.aaload lefts - //runtime.left-projection))) + //runtime.left_projection))) -(def: (right-projection lefts) +(def: (right_projection lefts) (-> Nat (Bytecode Any)) ($_ _.compose (_.checkcast //type.tuple) (..int lefts) - //runtime.right-projection)) + //runtime.right_projection)) -(def: (path' stack-depth @else @end phase archive path) +(def: (path' stack_depth @else @end phase archive path) (-> Nat Label Label (Generator Path)) (.case path #synthesis.Pop @@ -104,7 +104,7 @@ (do phase.monad [bodyG (phase archive bodyS)] (wrap ($_ _.compose - (..pop-alt stack-depth) + (..pop_alt stack_depth) bodyG (_.goto @end)))) @@ -112,8 +112,8 @@ [(^ (<pattern> lefts)) (operation\wrap (do _.monad - [@success _.new-label - @fail _.new-label] + [@success _.new_label + @fail _.new_label] ($_ _.compose ..peek (_.checkcast //type.variant) @@ -123,10 +123,10 @@ _.dup (_.ifnull @fail) (_.goto @success) - (_.set-label @fail) + (_.set_label @fail) _.pop (_.goto @else) - (_.set-label @success) + (_.set_label @success) //runtime.push)))]) ([synthesis.side/left false] [synthesis.side/right true]) @@ -137,19 +137,19 @@ ..peek (<projection> lefts) //runtime.push))]) - ([synthesis.member/left ..left-projection] - [synthesis.member/right ..right-projection]) + ([synthesis.member/left ..left_projection] + [synthesis.member/right ..right_projection]) ## Extra optimization (^ (synthesis.path/seq (synthesis.member/left 0) - (synthesis.!bind-top register thenP))) + (synthesis.!bind_top register thenP))) (do phase.monad - [thenG (path' stack-depth @else @end phase archive thenP)] + [thenG (path' stack_depth @else @end phase archive thenP)] (wrap ($_ _.compose ..peek (_.checkcast //type.tuple) - _.iconst-0 + _.iconst_0 _.aaload (_.astore register) thenG))) @@ -158,9 +158,9 @@ (^template [<pm> <projection>] [(^ (synthesis.path/seq (<pm> lefts) - (synthesis.!bind-top register thenP))) + (synthesis.!bind_top register thenP))) (do phase.monad - [then! (path' stack-depth @else @end phase archive thenP)] + [then! (path' stack_depth @else @end phase archive thenP)] (wrap ($_ _.compose ..peek (_.checkcast //type.tuple) @@ -168,25 +168,25 @@ <projection> (_.astore register) then!)))]) - ([synthesis.member/left //runtime.left-projection] - [synthesis.member/right //runtime.right-projection]) + ([synthesis.member/left //runtime.left_projection] + [synthesis.member/right //runtime.right_projection]) (#synthesis.Alt leftP rightP) (do phase.monad - [@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)] + [@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) + (_.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)] + [left! (path' stack_depth @else @end phase archive leftP) + right! (path' stack_depth @else @end phase archive rightP)] (wrap ($_ _.compose left! right!))) @@ -198,14 +198,14 @@ (def: (path @end phase archive path) (-> Label (Generator Path)) (do phase.monad - [@else //runtime.forge-label + [@else //runtime.forge_label pathG (..path' 1 @else @end phase archive path)] (wrap ($_ _.compose pathG - (_.set-label @else) + (_.set_label @else) _.pop - //runtime.pm-failure - _.aconst-null + //runtime.pm_failure + _.aconst_null (_.goto @end))))) (def: #export (if phase archive [conditionS thenS elseS]) @@ -215,17 +215,17 @@ thenG (phase archive thenS) elseG (phase archive elseS)] (wrap (do _.monad - [@else _.new-label - @end _.new-label] + [@else _.new_label + @end _.new_label] ($_ _.compose conditionG (//value.unwrap type.boolean) (_.ifeq @else) thenG (_.goto @end) - (_.set-label @else) + (_.set_label @else) elseG - (_.set-label @end)))))) + (_.set_label @end)))))) (def: #export (let phase archive [inputS register bodyS]) (Generator [Synthesis Register Synthesis]) @@ -241,26 +241,26 @@ (Generator [(List synthesis.Member) Synthesis]) (do phase.monad [recordG (phase archive recordS)] - (wrap (list\fold (function (_ step so-far) + (wrap (list\fold (function (_ step so_far) (.let [next (.case step (#.Left lefts) - (..left-projection lefts) + (..left_projection lefts) (#.Right lefts) - (..right-projection lefts))] - (_.compose so-far next))) + (..right_projection lefts))] + (_.compose so_far next))) recordG (list.reverse path))))) (def: #export (case phase archive [valueS path]) (Generator [Synthesis Path]) (do phase.monad - [@end //runtime.forge-label + [@end //runtime.forge_label valueG (phase archive valueS) pathG (..path @end phase archive path)] (wrap ($_ _.compose - _.aconst-null + _.aconst_null valueG //runtime.push pathG - (_.set-label @end))))) + (_.set_label @end))))) 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 da80cbfdd..943604bbc 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 @@ -75,80 +75,80 @@ (_\wrap [])) ))) -(def: this-offset 1) +(def: this_offset 1) -(def: #export (method class environment function-arity @begin body apply-arity) +(def: #export (method class environment function_arity @begin body apply_arity) (-> (Type Class) (Environment Synthesis) Arity Label (Bytecode Any) Arity (Resource Method)) - (let [num-partials (dec function-arity) - over-extent (i.- (.int apply-arity) - (.int function-arity))] + (let [num_partials (dec function_arity) + over_extent (i.- (.int apply_arity) + (.int function_arity))] (method.method //.modifier ////runtime.apply::name - (////runtime.apply::type apply-arity) + (////runtime.apply::type apply_arity) (list) - (#.Some (case num-partials + (#.Some (case num_partials 0 ($_ _.compose ////reference.this - (..inputs ..this-offset apply-arity) - (_.invokevirtual class //implementation.name (//implementation.type function-arity)) + (..inputs ..this_offset apply_arity) + (_.invokevirtual class //implementation.name (//implementation.type function_arity)) _.areturn) _ (do _.monad - [@default _.new-label - @labelsH _.new-label - @labelsT (|> _.new-label - (list.repeat (dec num-partials)) + [@default _.new_label + @labelsH _.new_label + @labelsT (|> _.new_label + (list.repeat (dec num_partials)) (monad.seq _.monad)) #let [cases (|> (list\compose (#.Cons [@labelsH @labelsT]) (list @default)) list.enumeration (list\map (function (_ [stage @case]) - (let [current-partials (|> (list.indices stage) + (let [current_partials (|> (list.indices stage) (list\map (///partial.get class)) (monad.seq _.monad)) - already-partial? (n.> 0 stage) - exact-match? (i.= over-extent (.int stage)) - has-more-than-necessary? (i.> over-extent (.int stage))] + already_partial? (n.> 0 stage) + exact_match? (i.= over_extent (.int stage)) + has_more_than_necessary? (i.> over_extent (.int stage))] ($_ _.compose - (_.set-label @case) - (cond exact-match? + (_.set_label @case) + (cond exact_match? ($_ _.compose ////reference.this - (if already-partial? + (if already_partial? (_.invokevirtual class //reset.name (//reset.type class)) (_\wrap [])) - current-partials - (..inputs ..this-offset apply-arity) - (_.invokevirtual class //implementation.name (//implementation.type function-arity)) + current_partials + (..inputs ..this_offset apply_arity) + (_.invokevirtual class //implementation.name (//implementation.type function_arity)) _.areturn) - has-more-than-necessary? - (let [inputs-to-completion (|> function-arity (n.- stage)) - inputs-left (|> apply-arity (n.- inputs-to-completion))] + has_more_than_necessary? + (let [inputs_to_completion (|> function_arity (n.- stage)) + inputs_left (|> apply_arity (n.- inputs_to_completion))] ($_ _.compose ////reference.this (_.invokevirtual class //reset.name (//reset.type class)) - current-partials - (..inputs ..this-offset inputs-to-completion) - (_.invokevirtual class //implementation.name (//implementation.type function-arity)) - (apply (n.+ ..this-offset inputs-to-completion) inputs-left) + current_partials + (..inputs ..this_offset inputs_to_completion) + (_.invokevirtual class //implementation.name (//implementation.type function_arity)) + (apply (n.+ ..this_offset inputs_to_completion) inputs_left) _.areturn)) - ## (i.< over-extent (.int stage)) - (let [current-environment (|> (list.indices (list.size environment)) + ## (i.< over_extent (.int stage)) + (let [current_environment (|> (list.indices (list.size environment)) (list\map (///foreign.get class)) (monad.seq _.monad)) - missing-partials (|> _.aconst-null - (list.repeat (|> num-partials (n.- apply-arity) (n.- stage))) + missing_partials (|> _.aconst_null + (list.repeat (|> num_partials (n.- apply_arity) (n.- stage))) (monad.seq _.monad))] ($_ _.compose (_.new class) _.dup - current-environment + current_environment ///partial/count.value - (..increment apply-arity) - current-partials - (..inputs ..this-offset apply-arity) - missing-partials - (_.invokevirtual class //init.name (//init.type environment function-arity)) + (..increment apply_arity) + current_partials + (..inputs ..this_offset apply_arity) + missing_partials + (_.invokevirtual class //init.name (//init.type environment function_arity)) _.areturn))))))) (monad.seq _.monad))]] ($_ _.compose diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/init.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/init.lux index ef5717521..f44d62118 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/init.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/init.lux @@ -56,18 +56,18 @@ type.void (list)])) -(def: no-partials (|> 0 unsigned.u1 try.assumed _.bipush)) +(def: no_partials (|> 0 unsigned.u1 try.assumed _.bipush)) -(def: #export (super environment-size arity) +(def: #export (super environment_size arity) (-> Nat Arity (Bytecode Any)) - (let [arity-register (inc environment-size)] + (let [arity_register (inc environment_size)] ($_ _.compose (if (arity.unary? arity) - ..no-partials - (_.iload arity-register)) + ..no_partials + (_.iload arity_register)) (_.invokespecial ///abstract.class ..name ///abstract.init)))) -(def: (store-all amount put offset) +(def: (store_all amount put offset) (-> Nat (-> Register (Bytecode Any) (Bytecode Any)) (-> Register Register) @@ -80,19 +80,19 @@ (def: #export (method class environment arity) (-> (Type Class) (Environment Synthesis) Arity (Resource Method)) - (let [environment-size (list.size environment) - offset-foreign (: (-> Register Register) + (let [environment_size (list.size environment) + offset_foreign (: (-> Register Register) (n.+ 1)) - offset-arity (: (-> Register Register) - (|>> offset-foreign (n.+ environment-size))) - offset-partial (: (-> Register Register) - (|>> offset-arity (n.+ 1)))] + offset_arity (: (-> Register Register) + (|>> offset_foreign (n.+ environment_size))) + offset_partial (: (-> Register Register) + (|>> offset_arity (n.+ 1)))] (method.method //.modifier ..name (..type environment arity) (list) (#.Some ($_ _.compose ////reference.this - (..super environment-size arity) - (store-all environment-size (///foreign.put class) offset-foreign) - (store-all (dec arity) (///partial.put class) offset-partial) + (..super environment_size arity) + (store_all environment_size (///foreign.put class) offset_foreign) + (store_all (dec arity) (///partial.put class) offset_partial) _.return))))) 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 f6bfa0278..19c84c828 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 @@ -42,12 +42,12 @@ ["." arity (#+ Arity)] ["." phase]]]]]]) -(def: #export (instance' foreign-setup class environment arity) +(def: #export (instance' foreign_setup class environment arity) (-> (List (Bytecode Any)) (Type Class) (Environment Synthesis) Arity (Bytecode Any)) ($_ _.compose (_.new class) _.dup - (monad.seq _.monad foreign-setup) + (monad.seq _.monad foreign_setup) (///partial.new arity) (_.invokespecial class //init.name (//init.type environment arity)))) @@ -59,23 +59,23 @@ (def: #export (method class environment arity) (-> (Type Class) (Environment Synthesis) Arity (Resource Method)) - (let [after-this (: (-> Nat Nat) + (let [after_this (: (-> Nat Nat) (n.+ 1)) - environment-size (list.size environment) - after-environment (: (-> Nat Nat) - (|>> after-this (n.+ environment-size))) - after-arity (: (-> Nat Nat) - (|>> after-environment (n.+ 1)))] + environment_size (list.size environment) + after_environment (: (-> Nat Nat) + (|>> after_this (n.+ environment_size))) + after_arity (: (-> Nat Nat) + (|>> after_environment (n.+ 1)))] (method.method //.modifier //init.name (//init.type environment arity) (list) (#.Some ($_ _.compose ////reference.this - (//init.super environment-size arity) + (//init.super environment_size arity) (monad.map _.monad (function (_ register) - (///foreign.put class register (_.aload (after-this register)))) - (list.indices environment-size)) + (///foreign.put class register (_.aload (after_this register)))) + (list.indices environment_size)) (monad.map _.monad (function (_ register) - (///partial.put class register (_.aload (after-arity register)))) + (///partial.put class register (_.aload (after_arity register)))) (list.indices (n.- ///arity.minimum arity))) _.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 2f6b8041c..c0fb1765f 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 @@ -137,7 +137,7 @@ (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.normalize name) + class-path-separator (name.normal name) "___" (%.nat (text\hash name)))] (do try.monad [[value definition] (evaluate! library loader class-name valueG)] @@ -150,7 +150,7 @@ (: //runtime.Host (implementation (def: (evaluate! temp-label valueG) - (let [eval-class (|> temp-label name.normalize (text.replace-all " " "$"))] + (let [eval-class (|> temp-label name.normal (text.replace-all " " "$"))] (\ try.monad map product.left (..evaluate! library loader eval-class valueG)))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/program.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/program.lux index 67a384781..e87a3f0df 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/program.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/program.lux @@ -48,58 +48,58 @@ class.final )) -(def: nil //runtime.none-injection) +(def: nil //runtime.none_injection) -(def: amount-of-inputs +(def: amount_of_inputs (Bytecode Any) ($_ _.compose - _.aload-0 + _.aload_0 _.arraylength)) (def: decrease (Bytecode Any) ($_ _.compose - _.iconst-1 + _.iconst_1 _.isub)) (def: head (Bytecode Any) ($_ _.compose _.dup - _.aload-0 + _.aload_0 _.swap _.aaload _.swap - _.dup-x2 + _.dup_x2 _.pop)) (def: pair (Bytecode Any) ($_ _.compose - _.iconst-2 + _.iconst_2 (_.anewarray ^Object) - _.dup-x1 + _.dup_x1 _.swap - _.iconst-0 + _.iconst_0 _.swap _.aastore - _.dup-x1 + _.dup_x1 _.swap - _.iconst-1 + _.iconst_1 _.swap _.aastore)) -(def: cons //runtime.right-injection) +(def: cons //runtime.right_injection) -(def: input-list +(def: input_list (Bytecode Any) (do _.monad - [@loop _.new-label - @end _.new-label] + [@loop _.new_label + @end _.new_label] ($_ _.compose ..nil - ..amount-of-inputs - (_.set-label @loop) + ..amount_of_inputs + (_.set_label @loop) ..decrease _.dup (_.iflt @end) @@ -108,28 +108,29 @@ ..cons _.swap (_.goto @loop) - (_.set-label @end) + (_.set_label @end) _.pop))) -(def: feed-inputs //runtime.apply) +(def: feed_inputs + //runtime.apply) -(def: run-io +(def: run_io (Bytecode Any) ($_ _.compose (_.checkcast //function/abstract.class) - _.aconst-null + _.aconst_null //runtime.apply)) (def: #export (program program) (-> (Bytecode Any) Definition) - (let [super-class (|> ..^Object type.reflection reflection.reflection name.internal) + (let [super_class (|> ..^Object type.reflection reflection.reflection name.internal) main (method.method ..main::modifier "main" ..main::type (list) (#.Some ($_ _.compose program - ..input-list - ..feed-inputs - ..run-io + ..input_list + ..feed_inputs + ..run_io _.return)))] [..class (<| (format.run class.writer) @@ -137,7 +138,7 @@ (class.class version.v6_0 ..program::modifier (name.internal ..class) - super-class + super_class (list) (list) (list main) 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 c41e5c16a..441cf5c63 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 @@ -28,26 +28,26 @@ (def: #export this (Bytecode Any) - _.aload-0) + _.aload_0) (template [<name> <prefix>] [(def: #export <name> (-> Register Text) (|>> %.nat (format <prefix>)))] - [foreign-name "f"] - [partial-name "p"] + [foreign_name "f"] + [partial_name "p"] ) (def: (foreign archive variable) (-> Archive Register (Operation (Bytecode Any))) (do {! ////.monad} - [bytecode-name (\ ! map //runtime.class-name + [bytecode_name (\ ! map //runtime.class_name (generation.context archive))] (wrap ($_ _.compose ..this - (_.getfield (type.class bytecode-name (list)) - (..foreign-name variable) + (_.getfield (type.class bytecode_name (list)) + (..foreign_name variable) //type.value))))) (def: #export (variable archive variable) @@ -62,6 +62,6 @@ (def: #export (constant archive name) (-> Archive Name (Operation (Bytecode Any))) (do {! ////.monad} - [bytecode-name (\ ! map //runtime.class-name + [bytecode_name (\ ! map //runtime.class_name (generation.remember archive name))] - (wrap (_.getstatic (type.class bytecode-name (list)) //value.field //type.value)))) + (wrap (_.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 4ff9bdb81..6bc0ffe91 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 @@ -57,12 +57,12 @@ (case (if right? (.inc lefts) lefts) - 0 _.iconst-0 - 1 _.iconst-1 - 2 _.iconst-2 - 3 _.iconst-3 - 4 _.iconst-4 - 5 _.iconst-5 + 0 _.iconst_0 + 1 _.iconst_1 + 2 _.iconst_2 + 3 _.iconst_3 + 4 _.iconst_4 + 5 _.iconst_5 tag (case (signed.s1 (.int tag)) (#try.Success value) (_.bipush value) @@ -78,8 +78,8 @@ (def: #export (flag right?) (-> Bit (Bytecode Any)) (if right? - //runtime.right-flag - //runtime.left-flag)) + //runtime.right_flag + //runtime.left_flag)) (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/value.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/value.lux index 3e2ff3d09..36edc060a 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/value.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/value.lux @@ -27,23 +27,23 @@ ## else (undefined))))] - [primitive-wrapper + [primitive_wrapper box.boolean box.byte box.short box.int box.long box.float box.double box.char] - [primitive-unwrap + [primitive_unwrap "booleanValue" "byteValue" "shortValue" "intValue" "longValue" "floatValue" "doubleValue" "charValue"] ) (def: #export (wrap type) (-> (Type Primitive) (Bytecode Any)) - (let [wrapper (type.class (primitive-wrapper type) (list))] + (let [wrapper (type.class (primitive_wrapper type) (list))] (_.invokestatic wrapper "valueOf" (type.method [(list) (list type) wrapper (list)])))) (def: #export (unwrap type) (-> (Type Primitive) (Bytecode Any)) - (let [wrapper (type.class (primitive-wrapper type) (list))] + (let [wrapper (type.class (primitive_wrapper type) (list))] ($_ _.compose (_.checkcast wrapper) - (_.invokevirtual wrapper (primitive-unwrap type) (type.method [(list) (list) type (list)]))))) + (_.invokevirtual wrapper (primitive_unwrap type) (type.method [(list) (list) type (list)]))))) 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 8f1e5b117..f01c90d7a 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 @@ -107,7 +107,7 @@ (do {! meta.monad} [ids (monad.seq ! (list.repeat (list.size vars) meta.count))] (wrap (list (` (let [(~+ (|> vars - (list.zip/2 ids) + (list.zipped/2 ids) (list\map (function (_ [id var]) (list (code.local_identifier var) (` (_.var (~ (code.text (format "v" (%.nat id))))))))) 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 231bb4a29..07b72e742 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 @@ -75,7 +75,7 @@ (do {! meta.monad} [ids (monad.seq ! (list.repeat (list.size vars) meta.count))] (wrap (list (` (let [(~+ (|> vars - (list.zip/2 ids) + (list.zipped/2 ids) (list\map (function (_ [id var]) (list (code.local_identifier var) (` (_.var (~ (code.text (format "v" (%.nat id))))))))) 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 34009976f..26aeb7f76 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 @@ -114,7 +114,7 @@ (do {! meta.monad} [ids (monad.seq ! (list.repeat (list.size vars) meta.count))] (wrap (list (` (let [(~+ (|> vars - (list.zip/2 ids) + (list.zipped/2 ids) (list\map (function (_ [id var]) (list (code.local_identifier var) (` (_.var (~ (code.text (format "v" (%.nat id))))))))) 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 4917eb90f..f646f82cd 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 @@ -81,7 +81,7 @@ ((~' wrap) ((~ g!proc) [(~+ g!input+)]))) (~' _) - (macro.fail (wrong-arity (~ g!name) +1 (list.size (~ g!inputs)))))))))))))) + (macro.failure (wrong-arity (~ g!name) +1 (list.size (~ g!inputs)))))))))))))) (arity: nullary +0) (arity: unary +1) 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 40ef044f6..017a7a547 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 @@ -81,7 +81,7 @@ (do {! meta.monad} [ids (monad.seq ! (list.repeat (list.size vars) meta.count))] (wrap (list (` (let [(~+ (|> vars - (list.zip/2 ids) + (list.zipped/2 ids) (list\map (function (_ [id var]) (list (code.local_identifier var) (` (_.var (~ (code.text (format "v" (%.nat id))))))))) 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 3e8e09d8c..9e4f78b29 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 @@ -76,7 +76,7 @@ (do {! meta.monad} [ids (monad.seq ! (list.repeat (list.size vars) meta.count))] (wrap (list (` (let [(~+ (|> vars - (list.zip/2 ids) + (list.zipped/2 ids) (list\map (function (_ [id var]) (list (code.local_identifier var) (` (_.local (~ (code.text (format "v" (%.nat id))))))))) 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 ec3def7fd..f383839f3 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 @@ -63,7 +63,7 @@ (do {! meta.monad} [ids (monad.seq ! (list.repeat (list.size vars) meta.count))] (wrap (list (` (let [(~+ (|> vars - (list.zip/2 ids) + (list.zipped/2 ids) (list\map (function (_ [id var]) (list (code.local_identifier var) (` (_.var (~ (code.text (format "v" (%.nat id))))))))) diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive/artifact.lux b/stdlib/source/library/lux/tool/compiler/meta/archive/artifact.lux index 2c6deeb27..c7f699f87 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive/artifact.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive/artifact.lux @@ -141,7 +141,7 @@ [5 #Directive <binary>.text] [6 #Custom <binary>.text]) - _ (<>.fail (exception.construct ..invalid_category [tag])))))] + _ (<>.failure (exception.construct ..invalid_category [tag])))))] (|> (<binary>.row/64 category) (\ <>.monad map (row\fold (function (_ artifact registry) (product.right 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 cb52004f4..ba2cec5c2 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux @@ -10,7 +10,7 @@ ["." try (#+ Try)] ["." exception (#+ exception:)] [concurrency - ["." promise (#+ Promise) ("#\." monad)]] + ["." async (#+ Async) ("#\." monad)]] ["<>" parser ["<.>" binary (#+ Parser)]]] [data @@ -91,16 +91,16 @@ (get@ #static.artifact_extension static))) (def: (ensure_directory fs path) - (-> (file.System Promise) file.Path (Promise (Try Any))) - (do promise.monad + (-> (file.System Async) file.Path (Async (Try Any))) + (do async.monad [? (\ fs directory? path)] (if ? (wrap (#try.Success [])) (\ fs make_directory path)))) (def: #export (prepare fs static module_id) - (-> (file.System Promise) Static archive.ID (Promise (Try Any))) - (do {! promise.monad} + (-> (file.System Async) Static archive.ID (Async (Try Any))) + (do {! async.monad} [#let [module (..module fs static module_id)] module_exists? (\ fs directory? module)] (if module_exists? @@ -119,40 +119,40 @@ error]))))))))) (def: #export (write fs static module_id artifact_id content) - (-> (file.System Promise) Static archive.ID artifact.ID Binary (Promise (Try Any))) + (-> (file.System Async) Static archive.ID artifact.ID Binary (Async (Try Any))) (\ fs write content (..artifact fs static module_id artifact_id))) (def: #export (enable fs static) - (-> (file.System Promise) Static (Promise (Try Any))) - (do (try.with promise.monad) + (-> (file.System Async) Static (Async (Try Any))) + (do (try.with async.monad) [_ (..ensure_directory fs (get@ #static.target static))] (..ensure_directory fs (..archive fs static)))) (def: (general_descriptor fs static) - (-> (file.System Promise) Static file.Path) + (-> (file.System Async) Static file.Path) (format (..archive fs static) (\ fs separator) "general_descriptor")) (def: #export (freeze fs static archive) - (-> (file.System Promise) Static Archive (Promise (Try Any))) + (-> (file.System Async) Static Archive (Async (Try Any))) (\ fs write (archive.export ///.version archive) (..general_descriptor fs static))) (def: module_descriptor_file "module_descriptor") (def: (module_descriptor fs static module_id) - (-> (file.System Promise) Static archive.ID file.Path) + (-> (file.System Async) Static archive.ID file.Path) (format (..module fs static module_id) (\ fs separator) ..module_descriptor_file)) (def: #export (cache fs static module_id content) - (-> (file.System Promise) Static archive.ID Binary (Promise (Try Any))) + (-> (file.System Async) Static archive.ID Binary (Async (Try Any))) (\ fs write content (..module_descriptor fs static module_id))) (def: (read_module_descriptor fs static module_id) - (-> (file.System Promise) Static archive.ID (Promise (Try Binary))) + (-> (file.System Async) Static archive.ID (Async (Try Binary))) (\ fs read (..module_descriptor fs static module_id))) (def: parser @@ -177,8 +177,8 @@ (wrap (set@ #.modules modules (fresh_analysis_state host))))) (def: (cached_artifacts fs static module_id) - (-> (file.System Promise) Static archive.ID (Promise (Try (Dictionary Text Binary)))) - (let [! (try.with promise.monad)] + (-> (file.System Async) Static archive.ID (Async (Try (Dictionary Text Binary)))) + (let [! (try.with async.monad)] (|> (..module fs static module_id) (\ fs directory_files) (\ ! map (|>> (list\map (function (_ file) @@ -339,19 +339,19 @@ (def: (load_definitions fs static module_id host_environment descriptor document) (All [expression directive] - (-> (file.System Promise) Static archive.ID (generation.Host expression directive) + (-> (file.System Async) Static archive.ID (generation.Host expression directive) Descriptor (Document .Module) - (Promise (Try [[Descriptor (Document .Module) Output] - Bundles])))) - (do (try.with promise.monad) + (Async (Try [[Descriptor (Document .Module) Output] + Bundles])))) + (do (try.with async.monad) [actual (cached_artifacts fs static module_id) #let [expected (|> descriptor (get@ #descriptor.registry) artifact.artifacts)] - [document bundles output] (promise\wrap (loaded_document (get@ #static.artifact_extension static) host_environment module_id expected actual document))] + [document bundles output] (async\wrap (loaded_document (get@ #static.artifact_extension static) host_environment module_id expected actual document))] (wrap [[descriptor document output] bundles]))) (def: (purge! fs static [module_name module_id]) - (-> (file.System Promise) Static [Module archive.ID] (Promise (Try Any))) - (do {! (try.with promise.monad)} + (-> (file.System Async) Static [Module archive.ID] (Async (Try Any))) + (do {! (try.with async.monad)} [#let [cache (..module fs static module_id)] _ (|> cache (\ fs directory_files) @@ -404,15 +404,15 @@ (def: (load_every_reserved_module host_environment fs static import contexts archive) (All [expression directive] - (-> (generation.Host expression directive) (file.System Promise) Static Import (List Context) Archive - (Promise (Try [Archive .Lux Bundles])))) - (do {! (try.with promise.monad)} + (-> (generation.Host expression directive) (file.System Async) Static Import (List Context) Archive + (Async (Try [Archive .Lux Bundles])))) + (do {! (try.with async.monad)} [pre_loaded_caches (|> archive archive.reservations (monad.map ! (function (_ [module_name module_id]) (do ! [data (..read_module_descriptor fs static module_id) - [descriptor document] (promise\wrap (<binary>.run ..parser data))] + [descriptor document] (async\wrap (<binary>.run ..parser data))] (if (text\= archive.runtime_module module_name) (wrap [true [module_name [module_id [descriptor document]]]]) @@ -428,7 +428,7 @@ archive) (\ try.monad map (dependency.load_order $.key)) (\ try.monad join) - promise\wrap) + async\wrap) #let [purge (..full_purge pre_loaded_caches load_order)] _ (|> purge dictionary.entries @@ -440,7 +440,7 @@ [[descriptor,document,output bundles] (..load_definitions fs static module_id host_environment descriptor document)] (wrap [[module_name descriptor,document,output] bundles])))))] - (promise\wrap + (async\wrap (do {! try.monad} [archive (monad.fold ! (function (_ [[module descriptor,document,output] _bundle] archive) @@ -461,14 +461,14 @@ (def: #export (thaw host_environment fs static import contexts) (All [expression directive] - (-> (generation.Host expression directive) (file.System Promise) Static Import (List Context) - (Promise (Try [Archive .Lux Bundles])))) - (do promise.monad + (-> (generation.Host expression directive) (file.System Async) Static Import (List Context) + (Async (Try [Archive .Lux Bundles])))) + (do async.monad [binary (\ fs read (..general_descriptor fs static))] (case binary (#try.Success binary) - (do (try.with promise.monad) - [archive (promise\wrap (archive.import ///.version binary))] + (do (try.with async.monad) + [archive (async\wrap (archive.import ///.version binary))] (..load_every_reserved_module host_environment fs static import contexts archive)) (#try.Failure error) 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 6e619d93d..f62d00cf2 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/io/context.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/io/context.lux @@ -9,7 +9,7 @@ ["." try (#+ Try)] ["." exception (#+ exception:)] [concurrency - ["." promise (#+ Promise) ("#\." monad)]]] + ["." async (#+ Async) ("#\." monad)]]] [data [binary (#+ Binary)] ["." text ("#\." hash) @@ -48,19 +48,19 @@ (def: #export (path fs context module) (All [m] (-> (file.System m) Context Module file.Path)) (|> module - (//.sanitize fs) + (//.safe fs) (format context (\ fs separator)))) (def: (find_source_file fs importer contexts module extension) - (-> (file.System Promise) Module (List Context) Module Extension - (Promise (Try file.Path))) + (-> (file.System Async) Module (List Context) Module Extension + (Async (Try file.Path))) (case contexts #.Nil - (promise\wrap (exception.throw ..cannot_find_module [importer module])) + (async\wrap (exception.throw ..cannot_find_module [importer module])) (#.Cons context contexts') (let [path (format (..path fs context module) extension)] - (do promise.monad + (do async.monad [? (\ fs file? path)] (if ? (wrap (#try.Success path)) @@ -71,11 +71,11 @@ (format partial_host_extension ..lux_extension)) (def: (find_local_source_file fs importer import contexts partial_host_extension module) - (-> (file.System Promise) Module Import (List Context) Extension Module - (Promise (Try [file.Path Binary]))) + (-> (file.System Async) Module Import (List Context) Extension Module + (Async (Try [file.Path Binary]))) ## Preference is explicitly being given to Lux files that have a host extension. ## Normal Lux files (i.e. without a host extension) are then picked as fallback files. - (do {! promise.monad} + (do {! async.monad} [outcome (..find_source_file fs importer contexts module (..full_host_extension partial_host_extension))] (case outcome (#try.Success path) @@ -107,11 +107,11 @@ (exception.throw ..cannot_find_module [importer module])))))) (def: (find_any_source_file fs importer import contexts partial_host_extension module) - (-> (file.System Promise) Module Import (List Context) Extension Module - (Promise (Try [file.Path Binary]))) + (-> (file.System Async) Module Import (List Context) Extension Module + (Async (Try [file.Path Binary]))) ## Preference is explicitly being given to Lux files that have a host extension. ## Normal Lux files (i.e. without a host extension) are then picked as fallback files. - (do {! promise.monad} + (do {! async.monad} [outcome (find_local_source_file fs importer import contexts partial_host_extension module)] (case outcome (#try.Success [path data]) @@ -121,9 +121,9 @@ (wrap (..find_library_source_file importer import partial_host_extension module))))) (def: #export (read fs importer import contexts partial_host_extension module) - (-> (file.System Promise) Module Import (List Context) Extension Module - (Promise (Try Input))) - (do (try.with promise.monad) + (-> (file.System Async) Module Import (List Context) Extension Module + (Async (Try Input))) + (do (try.with async.monad) [[path binary] (..find_any_source_file fs importer import contexts partial_host_extension module)] (case (\ utf8.codec decode binary) (#try.Success code) @@ -133,21 +133,21 @@ #////.code code}) (#try.Failure _) - (promise\wrap (exception.throw ..cannot_read_module [module]))))) + (async\wrap (exception.throw ..cannot_read_module [module]))))) (type: #export Enumeration (Dictionary file.Path Binary)) (def: (enumerate_context fs directory enumeration) - (-> (file.System Promise) Context Enumeration (Promise (Try Enumeration))) - (do {! (try.with promise.monad)} + (-> (file.System Async) Context Enumeration (Async (Try Enumeration))) + (do {! (try.with async.monad)} [enumeration (|> directory (\ fs directory_files) (\ ! map (monad.fold ! (function (_ file enumeration) (if (text.ends_with? ..lux_extension file) (do ! [source_code (\ fs read file)] - (promise\wrap + (async\wrap (dictionary.try_put (file.name fs file) source_code enumeration))) (wrap enumeration))) enumeration)) @@ -158,12 +158,12 @@ (\ ! join)))) (def: Action - (type (All [a] (Promise (Try a))))) + (type (All [a] (Async (Try a))))) (def: #export (enumerate fs contexts) - (-> (file.System Promise) (List Context) (Action Enumeration)) + (-> (file.System Async) (List Context) (Action Enumeration)) (monad.fold (: (Monad Action) - (try.with promise.monad)) + (try.with async.monad)) (..enumerate_context fs) (: Enumeration (dictionary.new text.hash)) 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 60c50db11..8f0b9ee68 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux @@ -5,9 +5,7 @@ [abstract ["." monad (#+ Monad do)]] [control - ["." try (#+ Try)] - [concurrency - ["." promise (#+ Promise)]]] + ["." try (#+ Try)]] [data ["." binary (#+ Binary)] ["." maybe ("#\." functor)] diff --git a/stdlib/source/library/lux/tool/compiler/phase.lux b/stdlib/source/library/lux/tool/compiler/phase.lux index f7e3ddf03..522b564ab 100644 --- a/stdlib/source/library/lux/tool/compiler/phase.lux +++ b/stdlib/source/library/lux/tool/compiler/phase.lux @@ -68,13 +68,13 @@ [[state' output] (operation (get state))] (wrap [(set state' state) output])))) -(def: #export fail +(def: #export failure (-> Text Operation) (|>> #try.Failure (state.lift try.monad))) (def: #export (throw exception parameters) (All [e] (-> (Exception e) e Operation)) - (..fail (ex.construct exception parameters))) + (..failure (ex.construct exception parameters))) (def: #export (lift error) (All [s a] (-> (Try a) (Operation s a))) diff --git a/stdlib/source/library/lux/tool/interpreter.lux b/stdlib/source/library/lux/tool/interpreter.lux index 8008dea25..05daa46aa 100644 --- a/stdlib/source/library/lux/tool/interpreter.lux +++ b/stdlib/source/library/lux/tool/interpreter.lux @@ -34,34 +34,38 @@ (def: #export module "<INTERPRETER>") -(def: fresh-source Source [[..module 1 0] 0 ""]) +(def: fresh_source + Source + [[..module 1 0] 0 ""]) -(def: (add-line line [where offset input]) +(def: (add_line line [where offset input]) (-> Text Source Source) - [where offset (format input text.new-line line)]) + [where offset (format input text.new_line line)]) -(def: exit-command Text "exit") +(def: exit_command + Text + "exit") -(def: welcome-message +(def: welcome_message Text - (format text.new-line - "Welcome to the interpreter!" text.new-line - "Type '" ..exit-command "' to leave." text.new-line - text.new-line)) + (format text.new_line + "Welcome to the interpreter!" text.new_line + "Type '" ..exit_command "' to leave." text.new_line + text.new_line)) -(def: farewell-message +(def: farewell_message Text "Till next time...") -(def: enter-module +(def: enter_module (All [anchor expression directive] (Operation anchor expression directive Any)) - (directive.lift-analysis + (directive.lift_analysis (do phase.monad [_ (module.create 0 ..module)] - (analysis.set-current-module ..module)))) + (analysis.set_current_module ..module)))) -(def: (initialize Monad<!> Console<!> platform configuration generation-bundle) +(def: (initialize Monad<!> Console<!> platform configuration generation_bundle) (All [! anchor expression directive] (-> (Monad !) (Console !) (Platform ! anchor expression directive) @@ -69,7 +73,7 @@ (generation.Bundle anchor expression directive) (! (State+ anchor expression directive)))) (do Monad<!> - [state (platform.initialize platform generation-bundle) + [state (platform.initialize platform generation_bundle) state (platform.compile platform (set@ #cli.module syntax.prelude configuration) (set@ [#extension.state @@ -78,78 +82,78 @@ #.info #.mode] #.Interpreter state)) - [state _] (\ (get@ #platform.file-system platform) - lift (phase.run' state enter-module)) - _ (\ Console<!> write ..welcome-message)] + [state _] (\ (get@ #platform.file_system platform) + lift (phase.run' state enter_module)) + _ (\ Console<!> write ..welcome_message)] (wrap state))) -(with-expansions [<Interpretation> (as-is (Operation anchor expression directive [Type Any]))] - - (def: (interpret-directive code) - (All [anchor expression directive] - (-> Code <Interpretation>)) - (do phase.monad - [_ (total.phase code) - _ init.refresh] - (wrap [Any []]))) - - (def: (interpret-expression code) - (All [anchor expression directive] - (-> Code <Interpretation>)) - (do {! phase.monad} - [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)] - [_ codeT codeA] (directive.lift-analysis - (analysis.with-scope - (type.with-fresh-env - (do ! - [[codeT codeA] (type.with-inference - (analyse code)) - codeT (type.with-env - (check.clean codeT))] - (wrap [codeT codeA]))))) - codeS (directive.lift-synthesis - (synthesize codeA))] - (directive.lift-generation - (generation.with-buffer - (do ! - [codeH (generate codeS) - count generation.next - codeV (generation.evaluate! (format "interpretation_" (%.nat count)) codeH)] - (wrap [codeT codeV])))))) - - (def: (interpret configuration code) - (All [anchor expression directive] - (-> Configuration Code <Interpretation>)) - (function (_ state) - (case (<| (phase.run' state) - (:sharing [anchor expression directive] - {(State+ anchor expression directive) - state} - {<Interpretation> - (interpret-directive code)})) - (#try.Success [state' output]) - (#try.Success [state' output]) - - (#try.Failure error) - (if (ex.match? total.not-a-directive error) - (<| (phase.run' state) - (:sharing [anchor expression directive] - {(State+ anchor expression directive) - state} - {<Interpretation> - (interpret-expression code)})) - (#try.Failure error))))) - ) +(with_expansions [<Interpretation> (as_is (Operation anchor expression directive [Type Any]))] + + (def: (interpret_directive code) + (All [anchor expression directive] + (-> Code <Interpretation>)) + (do phase.monad + [_ (total.phase code) + _ init.refresh] + (wrap [Any []]))) + + (def: (interpret_expression code) + (All [anchor expression directive] + (-> Code <Interpretation>)) + (do {! phase.monad} + [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)] + [_ codeT codeA] (directive.lift_analysis + (analysis.with_scope + (type.with_fresh_env + (do ! + [[codeT codeA] (type.with_inference + (analyse code)) + codeT (type.with_env + (check.clean codeT))] + (wrap [codeT codeA]))))) + codeS (directive.lift_synthesis + (synthesize codeA))] + (directive.lift_generation + (generation.with_buffer + (do ! + [codeH (generate codeS) + count generation.next + codeV (generation.evaluate! (format "interpretation_" (%.nat count)) codeH)] + (wrap [codeT codeV])))))) + + (def: (interpret configuration code) + (All [anchor expression directive] + (-> Configuration Code <Interpretation>)) + (function (_ state) + (case (<| (phase.run' state) + (:sharing [anchor expression directive] + {(State+ anchor expression directive) + state} + {<Interpretation> + (interpret_directive code)})) + (#try.Success [state' output]) + (#try.Success [state' output]) + + (#try.Failure error) + (if (ex.match? total.not_a_directive error) + (<| (phase.run' state) + (:sharing [anchor expression directive] + {(State+ anchor expression directive) + state} + {<Interpretation> + (interpret_expression code)})) + (#try.Failure error))))) + ) (def: (execute configuration code) (All [anchor expression directive] (-> Configuration Code (Operation anchor expression directive Text))) (do phase.monad [[codeT codeV] (interpret configuration code) - state phase.get-state] + state phase.get_state] (wrap (/type.represent (get@ [#extension.state #directive.analysis #directive.state #extension.state] @@ -162,32 +166,32 @@ #state (State+ anchor expression directive) #source Source}) -(with-expansions [<Context> (as-is (Context anchor expression directive))] - (def: (read-eval-print context) - (All [anchor expression directive] - (-> <Context> (Try [<Context> Text]))) - (do try.monad - [#let [[_where _offset _code] (get@ #source context)] - [source' input] (syntax.parse ..module syntax.no-aliases (text.size _code) (get@ #source context)) - [state' representation] (let [## TODO: Simplify ASAP - state (:sharing [anchor expression directive] - {<Context> - context} - {(State+ anchor expression directive) - (get@ #state context)})] - (<| (phase.run' state) - ## TODO: Simplify ASAP - (:sharing [anchor expression directive] - {<Context> - context} - {(Operation anchor expression directive Text) - (execute (get@ #configuration context) input)})))] - (wrap [(|> context - (set@ #state state') - (set@ #source source')) - representation])))) - -(def: #export (run Monad<!> Console<!> platform configuration generation-bundle) +(with_expansions [<Context> (as_is (Context anchor expression directive))] + (def: (read_eval_print context) + (All [anchor expression directive] + (-> <Context> (Try [<Context> Text]))) + (do try.monad + [#let [[_where _offset _code] (get@ #source context)] + [source' input] (syntax.parse ..module syntax.no_aliases (text.size _code) (get@ #source context)) + [state' representation] (let [## TODO: Simplify ASAP + state (:sharing [anchor expression directive] + {<Context> + context} + {(State+ anchor expression directive) + (get@ #state context)})] + (<| (phase.run' state) + ## TODO: Simplify ASAP + (:sharing [anchor expression directive] + {<Context> + context} + {(Operation anchor expression directive Text) + (execute (get@ #configuration context) input)})))] + (wrap [(|> context + (set@ #state state') + (set@ #source source')) + representation])))) + +(def: #export (run Monad<!> Console<!> platform configuration generation_bundle) (All [! anchor expression directive] (-> (Monad !) (Console !) (Platform ! anchor expression directive) @@ -198,25 +202,25 @@ [state (initialize Monad<!> Console<!> platform configuration)] (loop [context {#configuration configuration #state state - #source ..fresh-source} - multi-line? #0] + #source ..fresh_source} + multi_line? #0] (do ! - [_ (if multi-line? + [_ (if multi_line? (\ Console<!> write " ") (\ Console<!> write "> ")) - line (\ Console<!> read-line)] - (if (and (not multi-line?) - (text\= ..exit-command line)) - (\ Console<!> write ..farewell-message) - (case (read-eval-print (update@ #source (add-line line) context)) + line (\ Console<!> read_line)] + (if (and (not multi_line?) + (text\= ..exit_command line)) + (\ Console<!> write ..farewell_message) + (case (read_eval_print (update@ #source (add_line line) context)) (#try.Success [context' representation]) (do ! [_ (\ Console<!> write representation)] (recur context' #0)) (#try.Failure error) - (if (ex.match? syntax.end-of-file error) + (if (ex.match? syntax.end_of_file error) (recur context #1) (exec (log! (ex.construct ..error error)) - (recur (set@ #source ..fresh-source context) #0)))))) + (recur (set@ #source ..fresh_source context) #0)))))) ))) diff --git a/stdlib/source/library/lux/type.lux b/stdlib/source/library/lux/type.lux index 60ef3a4a2..fbf41c94d 100644 --- a/stdlib/source/library/lux/type.lux +++ b/stdlib/source/library/lux/type.lux @@ -1,4 +1,5 @@ -(.module: {#.doc "Basic functionality for working with types."} +(.module: + {#.doc "Basic functionality for working with types."} [library [lux (#- function) ["@" target] @@ -187,7 +188,7 @@ (n.= (list.size yparams) (list.size xparams)) (list\fold (.function (_ [x y] prev) (and prev (= x y))) #1 - (list.zip/2 xparams yparams))) + (list.zipped/2 xparams yparams))) (^template [<tag>] [[(<tag> xid) (<tag> yid)] @@ -214,7 +215,7 @@ (= xbody ybody) (list\fold (.function (_ [x y] prev) (and prev (= x y))) #1 - (list.zip/2 xenv yenv))) + (list.zipped/2 xenv yenv))) _ #0 diff --git a/stdlib/source/library/lux/type/check.lux b/stdlib/source/library/lux/type/check.lux index 24335b7bb..f01edbe64 100644 --- a/stdlib/source/library/lux/type/check.lux +++ b/stdlib/source/library/lux/type/check.lux @@ -165,7 +165,7 @@ (#try.Failure error) (#try.Failure error))) -(def: #export (fail message) +(def: #export (failure message) (All [a] (-> Text (Check a))) (function (_ context) (#try.Failure message))) @@ -179,7 +179,7 @@ (def: #export (throw exception message) (All [e a] (-> (Exception e) e (Check a))) - (..fail (exception.construct exception message))) + (..failure (exception.construct exception message))) (def: #export existential {#.doc "A producer of existential types."} @@ -460,7 +460,7 @@ (def: silent_failure! (All [a] (Check a)) - (..fail "")) + (..failure "")) ## TODO: "check_apply" can be optimized... (def: (check_apply check' assumptions expected actual) diff --git a/stdlib/source/library/lux/type/dynamic.lux b/stdlib/source/library/lux/type/dynamic.lux index b5a6e7fc0..5c5d79c81 100644 --- a/stdlib/source/library/lux/type/dynamic.lux +++ b/stdlib/source/library/lux/type/dynamic.lux @@ -47,5 +47,5 @@ (def: #export (format value) (-> Dynamic (Try Text)) (let [[type value] (:representation value)] - (debug.represent type value))) + (debug.representation type value))) ) diff --git a/stdlib/source/library/lux/type/implicit.lux b/stdlib/source/library/lux/type/implicit.lux index fb2598ab8..f405062e3 100644 --- a/stdlib/source/library/lux/type/implicit.lux +++ b/stdlib/source/library/lux/type/implicit.lux @@ -40,10 +40,10 @@ (\ meta.monad wrap type)) (#.Some [_ #.None]) - (meta.fail (format "Unbound type-var " (%.nat id))) + (meta.failure (format "Unbound type-var " (%.nat id))) #.None - (meta.fail (format "Unknown type-var " (%.nat id))) + (meta.failure (format "Unknown type-var " (%.nat id))) )) (def: (resolve_type var_name) @@ -67,7 +67,7 @@ (#.Apply arg func) (case (type.applied (list arg) func) #.None - (check.fail (format "Cannot apply type " (%.type func) " to type " (%.type arg))) + (check.failure (format "Cannot apply type " (%.type func) " to type " (%.type arg))) (#.Some sig_type') (find_member_type idx sig_type')) @@ -80,14 +80,14 @@ _ (if (n.= 0 idx) (\ check.monad wrap sig_type) - (check.fail (format "Cannot find member type " (%.nat idx) " for " (%.type sig_type)))))) + (check.failure (format "Cannot find member type " (%.nat idx) " for " (%.type sig_type)))))) (def: (find_member_name member) (-> Name (Meta Name)) (case member ["" simple_name] (meta.either (do meta.monad - [member (meta.normalize member) + [member (meta.normal member) _ (meta.resolve_tag member)] (wrap member)) (do {! meta.monad} @@ -99,13 +99,13 @@ tag_lists)]] (case candidates #.Nil - (meta.fail (format "Unknown tag: " (%.name member))) + (meta.failure (format "Unknown tag: " (%.name member))) (#.Cons winner #.Nil) (wrap winner) _ - (meta.fail (format "Too many candidate tags: " (%.list %.name candidates)))))) + (meta.failure (format "Too many candidate tags: " (%.list %.name candidates)))))) _ (\ meta.monad wrap member))) @@ -157,7 +157,7 @@ (wrap (list\fold (function (_ [imported_module definitions] tail) (prepare_definitions imported_module this_module_name definitions tail)) #.Nil - (list.zip/2 imported_modules accessible_definitions))))) + (list.zipped/2 imported_modules accessible_definitions))))) (def: (apply_function_type func arg) (-> Type Type (Check Type)) @@ -177,7 +177,7 @@ (wrap output)) _ - (check.fail (format "Invalid function type: " (%.type func))))) + (check.failure (format "Invalid function type: " (%.type func))))) (def: (concrete_type type) (-> Type (Check [(List Nat) Type])) @@ -229,7 +229,7 @@ (list [alt_name =deps])))) list\join) #.Nil - (meta.fail (format "No candidates for provisioning: " (%.type dep))) + (meta.failure (format "No candidates for provisioning: " (%.type dep))) found (wrap found)))) @@ -242,18 +242,18 @@ (do meta.monad [alts ..local_structs] (..test_provision provision context dep alts)) (do meta.monad [alts ..imported_structs] (..test_provision provision context dep alts)))) (#.Left error) - (check.fail error) + (check.failure error) (#.Right candidates) (case candidates #.Nil - (check.fail (format "No candidates for provisioning: " (%.type dep))) + (check.failure (format "No candidates for provisioning: " (%.type dep))) (#.Cons winner #.Nil) (\ check.monad wrap winner) _ - (check.fail (format "Too many candidates for provisioning: " (%.type dep) " --- " (%.list (|>> product.left %.name) candidates)))) + (check.failure (format "Too many candidates for provisioning: " (%.type dep) " --- " (%.list (|>> product.left %.name) candidates)))) )) (def: (test_alternatives sig_type member_idx input_types output_type alts) @@ -280,7 +280,7 @@ (list [alt_name =deps])))) list\join) #.Nil - (meta.fail (format "No alternatives for " (%.type (type.function input_types output_type)))) + (meta.failure (format "No alternatives for " (%.type (type.function input_types output_type)))) found (wrap found)))) @@ -351,7 +351,7 @@ chosen_ones (find_alternatives sig_type member_idx input_types output_type)] (case chosen_ones #.Nil - (meta.fail (format "No implementation could be found for member: " (%.name member))) + (meta.failure (format "No implementation could be found for member: " (%.name member))) (#.Cons chosen #.Nil) (wrap (list (` (\ (~ (instance$ chosen)) @@ -359,16 +359,16 @@ (~+ (list\map code.identifier args)))))) _ - (meta.fail (format "Too many implementations available: " - (|> chosen_ones - (list\map (|>> product.left %.name)) - (text.join_with ", ")) - " --- for type: " (%.type sig_type))))) + (meta.failure (format "Too many implementations available: " + (|> chosen_ones + (list\map (|>> product.left %.name)) + (text.join_with ", ")) + " --- for type: " (%.type sig_type))))) (#.Right [args _]) (do {! meta.monad} [labels (|> (macro.gensym "") (list.repeat (list.size args)) (monad.seq !))] - (wrap (list (` (let [(~+ (|> (list.zip/2 labels args) (list\map join_pair) list\join))] + (wrap (list (` (let [(~+ (|> (list.zipped/2 labels args) (list\map join_pair) list\join))] (..\\ (~ (code.identifier member)) (~+ labels))))))) )) @@ -385,7 +385,7 @@ (syntax: #export (with {implementations ..implicits} body) (do meta.monad [g!implicit+ (implicit_bindings (list.size implementations))] - (wrap (list (` (let [(~+ (|> (list.zip/2 g!implicit+ implementations) + (wrap (list (` (let [(~+ (|> (list.zipped/2 g!implicit+ implementations) (list\map (function (_ [g!implicit implementation]) (list g!implicit implementation))) list\join))] @@ -394,7 +394,7 @@ (syntax: #export (implicit: {implementations ..implicits}) (do meta.monad [g!implicit+ (implicit_bindings (list.size implementations))] - (wrap (|> (list.zip/2 g!implicit+ implementations) + (wrap (|> (list.zipped/2 g!implicit+ implementations) (list\map (function (_ [g!implicit implementation]) (` (def: (~ g!implicit) {#.implementation? #1} diff --git a/stdlib/source/library/lux/type/resource.lux b/stdlib/source/library/lux/type/resource.lux index 5a2b79c1d..5fc4e760a 100644 --- a/stdlib/source/library/lux/type/resource.lux +++ b/stdlib/source/library/lux/type/resource.lux @@ -9,7 +9,7 @@ ["." exception (#+ exception:)] ["." io (#+ IO)] [concurrency - ["." promise (#+ Promise)]] + ["." async (#+ Async)]] ["<>" parser ["<.>" code (#+ Parser)]]] [data @@ -78,7 +78,7 @@ [pure Identity identity.monad run_pure lift_pure] [sync IO io.monad run_sync lift_sync] - [async Promise promise.monad run_async lift_async] + [async Async async.monad run_async lift_async] ) (abstract: #export Ordered Any) @@ -110,10 +110,10 @@ [ordered_pure Identity identity.monad Ordered ordered_key] [ordered_sync IO io.monad Ordered ordered_key] - [ordered_async Promise promise.monad Ordered ordered_key] + [ordered_async Async async.monad Ordered ordered_key] [commutative_sync IO io.monad Commutative commutative_key] [commutative_pure Identity identity.monad Commutative commutative_key] - [commutative_async Promise promise.monad Commutative commutative_key] + [commutative_async Async async.monad Commutative commutative_key] ) (template [<name> <m> <monad>] @@ -125,7 +125,7 @@ [read_pure Identity identity.monad] [read_sync IO io.monad] - [read_async Promise promise.monad] + [read_async Async async.monad] )) (exception: #export (index_cannot_be_repeated {index Nat}) @@ -185,7 +185,7 @@ [exchange_pure Identity identity.monad] [exchange_sync IO io.monad] - [exchange_async Promise promise.monad] + [exchange_async Async async.monad] ) (def: amount @@ -211,8 +211,8 @@ [group_pure Identity identity.monad (~+ g!keys) [(~+ g!keys)]] [group_sync IO io.monad (~+ g!keys) [(~+ g!keys)]] - [group_async Promise promise.monad (~+ g!keys) [(~+ g!keys)]] + [group_async Async async.monad (~+ g!keys) [(~+ g!keys)]] [un_group_pure Identity identity.monad [(~+ g!keys)] (~+ g!keys)] [un_group_sync IO io.monad [(~+ g!keys)] (~+ g!keys)] - [un_group_async Promise promise.monad [(~+ g!keys)] (~+ g!keys)] + [un_group_async Async async.monad [(~+ g!keys)] (~+ g!keys)] ) diff --git a/stdlib/source/library/lux/world/console.lux b/stdlib/source/library/lux/world/console.lux index 5020554a1..ee52d4029 100644 --- a/stdlib/source/library/lux/world/console.lux +++ b/stdlib/source/library/lux/world/console.lux @@ -10,7 +10,7 @@ ["." exception (#+ exception:)] ["." io (#+ IO io)] [concurrency - ["." promise (#+ Promise)] + ["." async (#+ Async)] ["." atom]]] [data ["." text (#+ Char) @@ -27,11 +27,11 @@ close)) (def: #export (async console) - (-> (Console IO) (Console Promise)) + (-> (Console IO) (Console Async)) (`` (implementation (~~ (template [<capability>] [(def: <capability> - (|>> (\ console <capability>) promise.future))] + (|>> (\ console <capability>) async.future))] [read] [read_line] diff --git a/stdlib/source/library/lux/world/db/jdbc.lux b/stdlib/source/library/lux/world/db/jdbc.lux index 5ef233daf..4fed0df0e 100644 --- a/stdlib/source/library/lux/world/db/jdbc.lux +++ b/stdlib/source/library/lux/world/db/jdbc.lux @@ -8,7 +8,7 @@ ["." try (#+ Try)] ["ex" exception] [concurrency - ["." promise (#+ Promise) ("#\." monad)]] + ["." async (#+ Async) ("#\." monad)]] [security ["!" capability (#+ capability:)]]] [data @@ -101,10 +101,10 @@ (wrap result))) (def: #export (async db) - (-> (DB IO) (DB Promise)) + (-> (DB IO) (DB Async)) (`` (implementation (~~ (template [<name> <forge>] - [(def: <name> (<forge> (|>> (!.use (\ db <name>)) promise.future)))] + [(def: <name> (<forge> (|>> (!.use (\ db <name>)) async.future)))] [execute can-execute] [insert can-insert] @@ -123,20 +123,20 @@ (..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)))))))) + (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))))))) + (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 @@ -147,10 +147,10 @@ (..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))))))) + (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) @@ -167,10 +167,10 @@ (def: #export (with-async-db creds action) (All [a] (-> Credentials - (-> (DB Promise) (Promise (Try a))) - (Promise (Try a)))) - (do (try.with promise.monad) - [db (promise.future (..connect creds)) + (-> (DB Async) (Async (Try a))) + (Async (Try a)))) + (do (try.with async.monad) + [db (async.future (..connect creds)) result (action (..async db)) - _ (promise\wrap (io.run (!.use (\ db close) [])))] + _ (async\wrap (io.run (!.use (\ db close) [])))] (wrap result))) diff --git a/stdlib/source/library/lux/world/db/jdbc/output.lux b/stdlib/source/library/lux/world/db/jdbc/output.lux index b172a1ac9..e6aae5c1e 100644 --- a/stdlib/source/library/lux/world/db/jdbc/output.lux +++ b/stdlib/source/library/lux/world/db/jdbc/output.lux @@ -172,14 +172,14 @@ [temp (java/sql/ResultSet::close results)] (wrap (do try.monad [_ temp] - (try.fail error)))))) + (try.failure error)))))) (#try.Failure error) (do io.monad [temp (java/sql/ResultSet::close results)] (wrap (do try.monad [_ temp] - (try.fail error))))) + (try.failure error))))) (do io.monad [temp (java/sql/ResultSet::close results)] (wrap (do try.monad @@ -191,5 +191,5 @@ [temp (java/sql/ResultSet::close results)] (wrap (do try.monad [_ temp] - (try.fail error)))) + (try.failure error)))) )) diff --git a/stdlib/source/library/lux/world/file.lux b/stdlib/source/library/lux/world/file.lux index ac2912f16..d34904eea 100644 --- a/stdlib/source/library/lux/world/file.lux +++ b/stdlib/source/library/lux/world/file.lux @@ -12,7 +12,7 @@ ["." io (#+ IO) ("#\." functor)] ["." function] [concurrency - ["." promise (#+ Promise)] + ["." async (#+ Async)] ["." stm (#+ Var STM)]]] [data ["." bit ("#\." equivalence)] @@ -101,7 +101,7 @@ (maybe.default path))) (def: #export (async fs) - (-> (System IO) (System Promise)) + (-> (System IO) (System Async)) (`` (implementation (def: separator (\ fs separator)) @@ -109,7 +109,7 @@ (~~ (template [<name>] [(def: <name> (|>> (\ fs <name>) - promise.future))] + async.future))] [file?] [directory?] @@ -126,7 +126,7 @@ (~~ (template [<name>] [(def: (<name> input path) - (promise.future (\ fs <name> input path)))] + (async.future (\ fs <name> input path)))] [modify] [write] @@ -321,10 +321,10 @@ ["#::." (toString [] ffi.String)]) - (template: (with_promise <write> <type> <body>) + (template: (with_async <write> <type> <body>) (template.with_locals [<read>] - (let [[<read> <write>] (: [(Promise <type>) (promise.Resolver <type>)] - (promise.promise []))] + (let [[<read> <write>] (: [(Async <type>) (async.Resolver <type>)] + (async.async []))] (exec <body> <read>)))) @@ -345,7 +345,7 @@ (rmdir [ffi.String ffi.Function] Any)]) (def: (any_callback write!) - (-> (promise.Resolver (Try Any)) ffi.Function) + (-> (async.Resolver (Try Any)) ffi.Function) (<| (ffi.closure [error]) io.run write! @@ -354,7 +354,7 @@ (#try.Failure (Error::toString [] (:as Error error)))))) (def: (value_callback write!) - (All [a] (-> (promise.Resolver (Try a)) ffi.Function)) + (All [a] (-> (async.Resolver (Try a)) ffi.Function)) (<| (ffi.closure [error datum]) io.run write! @@ -402,15 +402,15 @@ "/")) (`` (implementation: #export default - (System Promise) + (System Async) (def: separator ..js_separator) (~~ (template [<name> <method>] [(def: (<name> path) - (do promise.monad - [?stats (with_promise write! (Try Stats) + (do async.monad + [?stats (with_async write! (Try Stats) (Fs::stat [path (..value_callback write!)] (..node_fs [])))] (wrap (case ?stats @@ -425,9 +425,9 @@ )) (def: (make_directory path) - (do promise.monad + (do async.monad [#let [node_fs (..node_fs [])] - outcome (with_promise write! (Try Any) + outcome (with_async write! (Try Any) (Fs::access [path (|> node_fs Fs::constants FsConstants::F_OK) (..any_callback write!)] @@ -437,21 +437,21 @@ (wrap (exception.throw ..cannot_make_directory [path])) (#try.Failure _) - (with_promise write! (Try Any) + (with_async write! (Try Any) (Fs::mkdir [path (..any_callback write!)] node_fs))))) (~~ (template [<name> <method>] [(def: (<name> path) - (do {! (try.with promise.monad)} + (do {! (try.with async.monad)} [#let [node_fs (..node_fs [])] - subs (with_promise write! (Try (Array ffi.String)) + subs (with_async write! (Try (Array ffi.String)) (Fs::readdir [path (..value_callback write!)] node_fs))] (|> subs array.to_list (list\map (|>> (format path ..js_separator))) (monad.map ! (function (_ sub) (\ ! map (|>> (<method> []) [sub]) - (with_promise write! (Try Stats) + (with_async write! (Try Stats) (Fs::stat [sub (..value_callback write!)] node_fs))))) (\ ! map (|>> (list.only product.right) (list\map product.left))))))] @@ -461,8 +461,8 @@ )) (def: (file_size path) - (do (try.with promise.monad) - [stats (with_promise write! (Try Stats) + (do (try.with async.monad) + [stats (with_async write! (Try Stats) (Fs::stat [path (..value_callback write!)] (..node_fs [])))] (wrap (|> stats @@ -470,8 +470,8 @@ f.nat)))) (def: (last_modified path) - (do (try.with promise.monad) - [stats (with_promise write! (Try Stats) + (do (try.with async.monad) + [stats (with_async write! (Try Stats) (Fs::stat [path (..value_callback write!)] (..node_fs [])))] (wrap (|> stats @@ -482,43 +482,43 @@ (def: (can_execute? path) (let [node_fs (..node_fs [])] - (\ promise.monad map + (\ async.monad map (|>> (case> (#try.Success _) true (#try.Failure _) false) #try.Success) - (with_promise write! (Try Any) + (with_async write! (Try Any) (Fs::access [path (|> node_fs Fs::constants FsConstants::X_OK) (..any_callback write!)] node_fs))))) (def: (read path) - (with_promise write! (Try Binary) + (with_async write! (Try Binary) (Fs::readFile [path (..value_callback write!)] (..node_fs [])))) (def: (delete path) - (do (try.with promise.monad) + (do (try.with async.monad) [#let [node_fs (..node_fs [])] - stats (with_promise write! (Try Stats) + stats (with_async write! (Try Stats) (Fs::stat [path (..value_callback write!)] node_fs))] - (with_promise write! (Try Any) + (with_async write! (Try Any) (if (Stats::isFile [] stats) (Fs::unlink [path (..any_callback write!)] node_fs) (Fs::rmdir [path (..any_callback write!)] node_fs))))) (def: (modify time_stamp path) - (with_promise write! (Try Any) + (with_async write! (Try Any) (let [when (|> time_stamp instant.relative duration.to_millis i.frac)] (Fs::utimes [path when when (..any_callback write!)] (..node_fs []))))) (~~ (template [<name> <method>] [(def: (<name> data path) - (with_promise write! (Try Any) + (with_async write! (Try Any) (<method> [path (Buffer::from data) (..any_callback write!)] (..node_fs []))))] @@ -527,7 +527,7 @@ )) (def: (move destination origin) - (with_promise write! (Try Any) + (with_async write! (Try Any) (Fs::rename [origin destination (..any_callback write!)] (..node_fs [])))) ))) @@ -1168,7 +1168,7 @@ (recur sub_directory tail))))))) (def: #export (mock separator) - (-> Text (System Promise)) + (-> Text (System Async)) (let [store (stm.var ..empty_mock)] (`` (implementation (def: separator @@ -1271,14 +1271,14 @@ store))) (def: (write content path) - (do promise.monad - [now (promise.future instant.now)] + (do async.monad + [now (async.future instant.now)] (stm.commit (..try_update! (..update_mock_file! separator path now content) store)))) (def: (append content path) - (do promise.monad - [now (promise.future instant.now)] + (do async.monad + [now (async.future instant.now)] (stm.commit (..try_update! (function (_ |store|) (do try.monad diff --git a/stdlib/source/library/lux/world/file/watch.lux b/stdlib/source/library/lux/world/file/watch.lux index 721e9b059..60b4f630c 100644 --- a/stdlib/source/library/lux/world/file/watch.lux +++ b/stdlib/source/library/lux/world/file/watch.lux @@ -11,7 +11,7 @@ ["." try (#+ Try)] ["." exception (#+ exception:)] [concurrency - ["." promise (#+ Promise)] + ["." async (#+ Async)] ["." stm (#+ STM Var)]]] [data ["." product] @@ -119,8 +119,8 @@ (wrap false)))) (def: (file_tracker fs directory) - (-> (//.System Promise) //.Path (Promise (Try File_Tracker))) - (do {! (try.with promise.monad)} + (-> (//.System Async) //.Path (Async (Try File_Tracker))) + (do {! (try.with async.monad)} [files (\ fs directory_files directory)] (monad.fold ! (function (_ file tracker) @@ -132,8 +132,8 @@ files))) (def: (poll_files fs directory) - (-> (//.System Promise) //.Path (Promise (Try (List [//.Path Instant])))) - (do {! (try.with promise.monad)} + (-> (//.System Async) //.Path (Async (Try (List [//.Path Instant])))) + (do {! (try.with async.monad)} [files (\ fs directory_files directory)] (monad.map ! (function (_ file) (|> file @@ -142,12 +142,12 @@ files))) (def: (poll_directory_changes fs [directory [concern file_tracker]]) - (-> (//.System Promise) [//.Path [Concern File_Tracker]] - (Promise (Try [[//.Path [Concern File_Tracker]] - [(List [//.Path Instant]) - (List [//.Path Instant Instant]) - (List //.Path)]]))) - (do {! (try.with promise.monad)} + (-> (//.System Async) [//.Path [Concern File_Tracker]] + (Async (Try [[//.Path [Concern File_Tracker]] + [(List [//.Path Instant]) + (List [//.Path Instant Instant]) + (List //.Path)]]))) + (do {! (try.with async.monad)} [current_files (..poll_files fs directory) #let [creations (if (..creation? concern) (list.only (|>> product.left (dictionary.key? file_tracker) not) @@ -183,12 +183,12 @@ deletions]]))) (def: #export (polling fs) - (-> (//.System Promise) (Watcher Promise)) + (-> (//.System Async) (Watcher Async)) (let [tracker (: (Var Directory_Tracker) (stm.var (dictionary.new text.hash)))] (implementation (def: (start new_concern path) - (do {! promise.monad} + (do {! async.monad} [exists? (\ fs directory? path)] (if exists? (do ! @@ -224,13 +224,13 @@ #.None (wrap (exception.throw ..not_being_watched [path])))))) (def: (poll _) - (do promise.monad + (do async.monad [@tracker (stm.commit (stm.read tracker))] - (do {! (try.with promise.monad)} + (do {! (try.with async.monad)} [changes (|> @tracker dictionary.entries (monad.map ! (..poll_directory_changes fs))) - _ (do promise.monad + _ (do async.monad [_ (stm.commit (stm.write (|> changes (list\map product.left) (dictionary.of_list text.hash)) @@ -255,7 +255,7 @@ ))) (def: #export (mock separator) - (-> Text [(//.System Promise) (Watcher Promise)]) + (-> Text [(//.System Async) (Watcher Async)]) (let [fs (//.mock separator)] [fs (..polling fs)])) @@ -355,13 +355,13 @@ (java/nio/file/WatchEvent$Kind java/lang/Object)) (def: (default_start watch_events watcher path) - (-> (List Watch_Event) java/nio/file/WatchService //.Path (Promise (Try java/nio/file/WatchKey))) + (-> (List Watch_Event) java/nio/file/WatchService //.Path (Async (Try java/nio/file/WatchKey))) (let [watch_events' (list\fold (function (_ [index watch_event] watch_events') (ffi.array_write index watch_event watch_events')) (ffi.array (java/nio/file/WatchEvent$Kind java/lang/Object) (list.size watch_events)) (list.enumeration watch_events))] - (promise.future + (async.future (java/nio/file/Path::register watcher watch_events' (|> path java/io/File::new java/io/File::toPath))))) @@ -406,42 +406,42 @@ )) (def: #export default - (IO (Try (Watcher Promise))) + (IO (Try (Watcher Async))) (do (try.with io.monad) [watcher (java/nio/file/FileSystem::newWatchService (java/nio/file/FileSystems::getDefault)) #let [tracker (stm.var (: (Dictionary //.Path [Concern java/nio/file/WatchKey]) (dictionary.new text.hash))) - stop (: (-> //.Path (Promise (Try Concern))) + stop (: (-> //.Path (Async (Try Concern))) (function (_ path) - (do {! promise.monad} + (do {! async.monad} [@tracker (stm.commit (stm.read tracker))] (case (dictionary.get path @tracker) (#.Some [concern key]) (do ! - [_ (promise.future + [_ (async.future (java/nio/file/WatchKey::cancel key)) _ (stm.commit (stm.update (dictionary.remove path) tracker))] (wrap (#try.Success concern))) #.None (wrap (exception.throw ..not_being_watched [path]))))))]] - (wrap (: (Watcher Promise) + (wrap (: (Watcher Async) (implementation (def: (start concern path) - (do promise.monad + (do async.monad [?concern (stop path)] - (do (try.with promise.monad) + (do (try.with async.monad) [key (..default_start (..watch_events (..also (try.default ..none ?concern) concern)) watcher path)] - (do promise.monad + (do async.monad [_ (stm.commit (stm.update (dictionary.put path [concern key]) tracker))] (wrap (#try.Success [])))))) (def: (concern path) - (do promise.monad + (do async.monad [@tracker (stm.commit (stm.read tracker))] (case (dictionary.get path @tracker) (#.Some [concern key]) @@ -451,7 +451,7 @@ (wrap (exception.throw ..not_being_watched [path]))))) (def: stop stop) (def: (poll _) - (promise.future (..default_poll watcher))) + (async.future (..default_poll watcher))) ))))) )] (for {@.old (as_is <jvm>) diff --git a/stdlib/source/library/lux/world/net/http.lux b/stdlib/source/library/lux/world/net/http.lux index 8e205e2a0..c526e6c97 100644 --- a/stdlib/source/library/lux/world/net/http.lux +++ b/stdlib/source/library/lux/world/net/http.lux @@ -4,7 +4,6 @@ [control [try (#+ Try)] [concurrency - [promise (#+ Promise)] [frp (#+ Channel)]] [parser ["." environment (#+ Environment)]]] diff --git a/stdlib/source/library/lux/world/net/http/client.lux b/stdlib/source/library/lux/world/net/http/client.lux index 95dbde0dc..2a160d0fd 100644 --- a/stdlib/source/library/lux/world/net/http/client.lux +++ b/stdlib/source/library/lux/world/net/http/client.lux @@ -10,7 +10,7 @@ ["." io (#+ IO)] ["." try (#+ Try)] [concurrency - ["." promise (#+ Promise)]]] + ["." async (#+ Async)]]] [data ["." binary (#+ Binary)] ["." maybe ("#\." functor)] @@ -207,16 +207,16 @@ (as_is))) (implementation: #export (async client) - (-> (Client IO) (Client Promise)) + (-> (Client IO) (Client Async)) (def: (request method url headers data) (|> (\ client request method url headers data) - promise.future - (\ promise.monad map + async.future + (\ async.monad map (|>> (case> (#try.Success [status message]) - (#try.Success [status (update@ #//.body (: (-> (//.Body IO) (//.Body Promise)) + (#try.Success [status (update@ #//.body (: (-> (//.Body IO) (//.Body Async)) (function (_ body) - (|>> body promise.future))) + (|>> body async.future))) message)]) (#try.Failure error) diff --git a/stdlib/source/library/lux/world/net/http/request.lux b/stdlib/source/library/lux/world/net/http/request.lux index 80ce2bbf5..b51e1af60 100644 --- a/stdlib/source/library/lux/world/net/http/request.lux +++ b/stdlib/source/library/lux/world/net/http/request.lux @@ -6,7 +6,7 @@ ["." monad (#+ do)] ["." try (#+ Try)] [concurrency - ["." promise (#+ Promise)] + ["." async (#+ Async)] ["." frp]] [parser ["<.>" json]]] @@ -45,8 +45,8 @@ output)) (def: (read-text-body body) - (-> Body (Promise (Try Text))) - (do promise.monad + (-> Body (Async (Try Text))) + (do async.monad [blobs (frp.consume body)] (wrap (\ encoding.utf8 decode (merge blobs))))) @@ -55,7 +55,7 @@ (def: #export (json reader server) (All [a] (-> (<json>.Reader a) (-> a Server) Server)) (function (_ (^@ request [identification protocol resource message])) - (do promise.monad + (do async.monad [?raw (read-text-body (get@ #//.body message))] (case (do try.monad [raw ?raw @@ -65,19 +65,19 @@ (server input request) (#try.Failure error) - (promise.resolved ..failure))))) + (async.resolved ..failure))))) (def: #export (text server) (-> (-> Text Server) Server) (function (_ (^@ request [identification protocol resource message])) - (do promise.monad + (do async.monad [?raw (read-text-body (get@ #//.body message))] (case ?raw (#try.Success content) (server content request) (#try.Failure error) - (promise.resolved ..failure))))) + (async.resolved ..failure))))) (def: #export (query property server) (All [a] (-> (Property a) (-> a Server) Server)) @@ -95,12 +95,12 @@ (server input request) (#try.Failure error) - (promise.resolved ..failure))))) + (async.resolved ..failure))))) (def: #export (form property server) (All [a] (-> (Property a) (-> a Server) Server)) (function (_ (^@ request [identification protocol resource message])) - (do promise.monad + (do async.monad [?body (read-text-body (get@ #//.body message))] (case (do try.monad [body ?body @@ -110,7 +110,7 @@ (server input request) (#try.Failure error) - (promise.resolved ..failure))))) + (async.resolved ..failure))))) (def: #export (cookies property server) (All [a] (-> (Property a) (-> a Server) Server)) @@ -125,4 +125,4 @@ (server input request) (#try.Failure error) - (promise.resolved ..failure)))) + (async.resolved ..failure)))) diff --git a/stdlib/source/library/lux/world/net/http/response.lux b/stdlib/source/library/lux/world/net/http/response.lux index 0ca825a44..ae96134b9 100644 --- a/stdlib/source/library/lux/world/net/http/response.lux +++ b/stdlib/source/library/lux/world/net/http/response.lux @@ -3,7 +3,7 @@ [lux (#- static) [control [concurrency - ["." promise] + ["." async] ["." frp ("#\." monad)]]] [data ["." text @@ -25,7 +25,7 @@ (def: #export (static response) (-> Response Server) (function (_ request) - (promise.resolved response))) + (async.resolved response))) (def: #export empty (-> Status Response) diff --git a/stdlib/source/library/lux/world/net/http/route.lux b/stdlib/source/library/lux/world/net/http/route.lux index 456ed9e36..857503a20 100644 --- a/stdlib/source/library/lux/world/net/http/route.lux +++ b/stdlib/source/library/lux/world/net/http/route.lux @@ -4,7 +4,7 @@ [control [monad (#+ do)] [concurrency - ["." promise]]] + ["." async]]] [data ["." maybe] ["." text] @@ -23,7 +23,7 @@ (server request) _ - (promise.resolved //response.not-found))))] + (async.resolved //response.not-found))))] [#//.HTTP http] [#//.HTTPS https] @@ -38,7 +38,7 @@ (server request) _ - (promise.resolved //response.not-found))))] + (async.resolved //response.not-found))))] [#//.Get get] [#//.Post post] @@ -61,12 +61,12 @@ (|>> (text.clip' (text.size path)) maybe.assume) resource) message]) - (promise.resolved //response.not-found)))) + (async.resolved //response.not-found)))) (def: #export (or primary alternative) (-> Server Server Server) (function (_ request) - (do promise.monad + (do async.monad [response (primary request) #let [[status message] response]] (if (n.= //status.not-found status) diff --git a/stdlib/source/library/lux/world/program.lux b/stdlib/source/library/lux/world/program.lux index 1607e14c3..a540bf2b1 100644 --- a/stdlib/source/library/lux/world/program.lux +++ b/stdlib/source/library/lux/world/program.lux @@ -12,7 +12,7 @@ ["." exception (#+ exception:)] [concurrency ["." atom] - ["." promise (#+ Promise)]] + ["." async (#+ Async)]] [parser ["." environment (#+ Environment)]]] [data @@ -69,7 +69,7 @@ (dictionary.of_list text.hash))))) (`` (implementation: #export (async program) - (-> (Program IO) (Program Promise)) + (-> (Program IO) (Program Async)) (~~ (template [<method>] [(def: <method> @@ -81,7 +81,7 @@ (~~ (template [<method>] [(def: <method> - (|>> (\ program <method>) promise.future))] + (|>> (\ program <method>) async.future))] [available_variables] [variable] diff --git a/stdlib/source/library/lux/world/shell.lux b/stdlib/source/library/lux/world/shell.lux index 00cba51fe..b186f27a8 100644 --- a/stdlib/source/library/lux/world/shell.lux +++ b/stdlib/source/library/lux/world/shell.lux @@ -14,7 +14,7 @@ ["?" policy (#+ Context Safety Safe)]] [concurrency ["." atom (#+ Atom)] - ["." promise (#+ Promise)]] + ["." async (#+ Async)]] [parser [environment (#+ Environment)]]] [data @@ -58,12 +58,12 @@ await)) (def: (async_process process) - (-> (Process IO) (Process Promise)) + (-> (Process IO) (Process Async)) (`` (implementation (~~ (template [<method>] [(def: <method> (|>> (\ process <method>) - promise.future))] + async.future))] [read] [error] @@ -83,10 +83,10 @@ execute)) (def: #export (async shell) - (-> (Shell IO) (Shell Promise)) + (-> (Shell IO) (Shell Async)) (implementation (def: (execute input) - (promise.future + (async.future (do (try.with io.monad) [process (\ shell execute input)] (wrap (..async_process process))))))) @@ -110,7 +110,7 @@ (-> Text Replacer (-> Text Text)) (text.replace_all bad (replacer bad))) -(def: sanitize_common_command +(def: safe_common_command (-> Replacer (Sanitizer Command)) (let [x0A (text.of_code (hex "0A")) xFF (text.of_code (hex "FF"))] @@ -133,39 +133,39 @@ (..replace "[" replacer) (..replace "]" replacer) (..replace "{" replacer) (..replace "}" replacer))))) -(def: (policy sanitize_command sanitize_argument) +(def: (policy safe_command safe_argument) (Ex [?] (-> (Sanitizer Command) (Sanitizer Argument) (Policy ?))) (?.with_policy (: (Context Safety Policy) (function (_ (^open "?\.")) (implementation - (def: command (|>> sanitize_command ?\can_upgrade)) - (def: argument (|>> sanitize_argument ?\can_upgrade)) + (def: command (|>> safe_command ?\can_upgrade)) + (def: argument (|>> safe_argument ?\can_upgrade)) (def: value ?\can_downgrade)))))) (def: unix_policy (let [replacer (: Replacer (|>> (format "\"))) - sanitize_command (: (Sanitizer Command) - (..sanitize_common_command replacer)) - sanitize_argument (: (Sanitizer Argument) - (|>> (..replace "'" replacer) - (text.enclose' "'")))] - (..policy sanitize_command sanitize_argument))) + safe_command (: (Sanitizer Command) + (..safe_common_command replacer)) + safe_argument (: (Sanitizer Argument) + (|>> (..replace "'" replacer) + (text.enclose' "'")))] + (..policy safe_command safe_argument))) (def: windows_policy (let [replacer (: Replacer (function.constant " ")) - sanitize_command (: (Sanitizer Command) - (|>> (..sanitize_common_command replacer) - (..replace "%" replacer) - (..replace "!" replacer))) - sanitize_argument (: (Sanitizer Argument) - (|>> (..replace "%" replacer) - (..replace "!" replacer) - (..replace text.double_quote replacer) - (text.enclose' text.double_quote)))] - (..policy sanitize_command sanitize_argument))) + safe_command (: (Sanitizer Command) + (|>> (..safe_common_command replacer) + (..replace "%" replacer) + (..replace "!" replacer))) + safe_argument (: (Sanitizer Argument) + (|>> (..replace "%" replacer) + (..replace "!" replacer) + (..replace text.double_quote replacer) + (text.enclose' text.double_quote)))] + (..policy safe_command safe_argument))) (with_expansions [<jvm> (as_is (import: java/lang/String ["#::." |