From 3289b9dcf9d5d1c1e5c380e3185065c8fd32535f Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 16 Aug 2021 01:12:01 -0400 Subject: Made extension-definition macros specify their bindings the same way as syntax:. --- stdlib/source/library/lux.lux | 76 +++++++++++++++++++------------------------ 1 file changed, 33 insertions(+), 43 deletions(-) (limited to 'stdlib/source/library/lux.lux') diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux index f534a51d9..f9be2bf36 100644 --- a/stdlib/source/library/lux.lux +++ b/stdlib/source/library/lux.lux @@ -1981,7 +1981,7 @@ (failure "Wrong syntax for <|")} (list\reverse tokens))) -(def:''' .private (compose f g) +(def:''' .private (function\composite f g) (list [(tag$ ["library/lux" "doc"]) (text$ "Function composition.")]) (All [a b c] @@ -2097,7 +2097,7 @@ #1 ("lux i64 =" reference sample))) -(def:''' .private (list\join xs) +(def:''' .private (list\joined xs) #End (All [a] (-> ($' List ($' List a)) ($' List a))) @@ -2119,8 +2119,8 @@ (if (every? (function' [size] ("lux i64 =" num_bindings size)) (list\map list\size data')) (|> data' - (list\map (compose apply (replacement_environment bindings'))) - list\join + (list\map (function\composite apply (replacement_environment bindings'))) + list\joined in_meta) (failure "Irregular arguments tuples for template."))) @@ -2355,7 +2355,7 @@ (do meta_monad [top_level_expansion (("lux type as" Macro' macro) args) recursive_expansion (monad\map meta_monad expansion top_level_expansion)] - (in (list\join recursive_expansion))) + (in (list\joined recursive_expansion))) #None (in_meta (list token))} @@ -2376,23 +2376,23 @@ (do meta_monad [expansion (("lux type as" Macro' macro) args) expansion' (monad\map meta_monad full_expansion expansion)] - (in (list\join expansion'))) + (in (list\joined expansion'))) #None (do meta_monad [args' (monad\map meta_monad full_expansion args)] - (in (list (form$ (#Item (identifier$ name) (list\join args'))))))} + (in (list (form$ (#Item (identifier$ name) (list\joined args'))))))} ?macro)) [_ (#Form members)] (do meta_monad [members' (monad\map meta_monad full_expansion members)] - (in (list (form$ (list\join members'))))) + (in (list (form$ (list\joined members'))))) [_ (#Tuple members)] (do meta_monad [members' (monad\map meta_monad full_expansion members)] - (in (list (tuple$ (list\join members'))))) + (in (list (tuple$ (list\joined members'))))) [_ (#Record pairs)] (do meta_monad @@ -2807,7 +2807,7 @@ _ (let' [pairs (|> patterns (list\map (function' [pattern] (list pattern body))) - (list\join))] + (list\joined))] (in_meta (list\compose pairs branches)))) _ (failure "Wrong syntax for ^or"))) @@ -3568,10 +3568,10 @@ _ (failure "Invalid implementation member.")))) - (list\join tokens'))] + (list\joined tokens'))] (in (list (record$ members))))) -(def: (text\join_with separator parts) +(def: (text\interposed separator parts) (-> Text (List Text) Text) (case parts #End @@ -3822,7 +3822,7 @@ _ (failure "Interfaces require typed members!")))) - (list\join methods'))) + (list\joined methods'))) .let [def_name (local_identifier$ name) interface_type (record$ (list\map (: (-> [Text Code] [Code Code]) (function (_ [module_name m_type]) @@ -4010,23 +4010,14 @@ (relative_ups ("lux i64 +" 1 relatives) input) relatives))) -(def: (list\take amount list) - (All [a] (-> Nat (List a) (List a))) - (case [amount list] - (^or [0 _] [_ #End]) - #End - - [_ (#Item head tail)] - (#Item head (list\take ("lux i64 -" 1 amount) tail)))) - -(def: (list\drop amount list) +(def: (list\after amount list) (All [a] (-> Nat (List a) (List a))) (case [amount list] (^or [0 _] [_ #End]) list [_ (#Item _ tail)] - (list\drop ("lux i64 -" 1 amount) tail))) + (list\after ("lux i64 -" 1 amount) tail))) (def: (absolute_module_name nested? relative_root module) (-> Bit Text Text (Meta Text)) @@ -4042,10 +4033,9 @@ (if (n/< (list\size parts) jumps) (let [prefix (|> parts list\reverse - (list\drop jumps) + (list\after jumps) list\reverse - (list\interposed ..module_separator) - (text\join_with "")) + (text\interposed ..module_separator)) clean ("lux text clip" relatives (|> module "lux text size" ("lux i64 -" relatives)) module) output (case ("lux text size" clean) 0 prefix @@ -4130,7 +4120,7 @@ "Wrong syntax for import @ " current_module ..\n (code\encode token))))))) imports)] - (in (list\join imports')))) + (in (list\joined imports')))) (def: (exported_definitions module state) (-> Text (Meta (List Text))) @@ -4155,7 +4145,7 @@ (list))))) (let [{#module_hash _ #module_aliases _ #definitions definitions #imports _ #tags tags #types types #module_annotations _ #module_state _} =module] definitions))] - (#Right state (list\join to_alias))) + (#Right state (list\joined to_alias))) #None (#Left ($_ text\compose @@ -4541,7 +4531,7 @@ (function (_ [sub_tag_index sname stype]) (open_declaration alias tags' sub_tag_index sname source+ stype))) (enumeration (zipped/2 tags' members')))] - (in_meta (list\join decls'))) + (in_meta (list\joined decls'))) _ (in_meta (list (` ("lux def" (~ (local_identifier$ (..module_alias "" short alias))) @@ -4576,7 +4566,7 @@ (function (_ [tag_index sname stype]) (open_declaration alias tags tag_index sname source stype))) (enumeration (zipped/2 tags members)))] - (in_meta (list\join decls'))) + (in_meta (list\joined decls'))) _ (failure (text\compose "Can only 'open:' structs: " (type\encode struct_type))))) @@ -4685,7 +4675,7 @@ (list\map (function (_ name) (` (open: (~ (text$ alias)) (~ (identifier$ [module_name name]))))) structs)))) - list\join)]] + list\joined)]] (in (list\compose defs openings)))) (macro: (refer tokens) @@ -4851,7 +4841,7 @@ (#Item (list new_binding old_record) accesses')])) [record (: (List (List Code)) #End)] pairs) - accesses (list\join (list\reverse accesses'))]] + accesses (list\joined (list\reverse accesses'))]] (in (list (` (let [(~+ accesses)] (~ update_expr))))))) @@ -4998,8 +4988,8 @@ (let [apply (: (-> Replacement_Environment (List Code)) (function (_ env) (list\map (realized_template env) templates)))] (|> data' - (list\map (compose apply (replacement_environment bindings'))) - list\join + (list\map (function\composite apply (replacement_environment bindings'))) + list\joined in)) #None)))) (#Some output) @@ -5074,9 +5064,9 @@ (def: (location_padding baseline [_ old_line old_column] [_ new_line new_column]) (-> Nat Location Location Text) (if ("lux i64 =" old_line new_line) - (text\join_with "" (repeated (.int ("lux i64 -" old_column new_column)) " ")) - (let [extra_lines (text\join_with "" (repeated (.int ("lux i64 -" old_line new_line)) ..\n)) - space_padding (text\join_with "" (repeated (.int ("lux i64 -" baseline new_column)) " "))] + (text\interposed "" (repeated (.int ("lux i64 -" old_column new_column)) " ")) + (let [extra_lines (text\interposed "" (repeated (.int ("lux i64 -" old_line new_line)) ..\n)) + space_padding (text\interposed "" (repeated (.int ("lux i64 -" baseline new_column)) " "))] (text\compose extra_lines space_padding)))) (def: (text\size x) @@ -5093,7 +5083,7 @@ (function (_ [left right]) (list left right)))] (|>> (list\map pair_list) - list\join))) + list\joined))) (def: (example_documentation prev_location baseline example) (-> Location Nat Code [Location Text]) @@ -5139,7 +5129,7 @@ (|> comment (text\all_split_by ..\n) (list\map (function (_ line) ($_ text\compose "... " line ..\n))) - (text\join_with "")) + (text\interposed "")) (#Documentation_Example example) (let [baseline (baseline_column example) @@ -5162,7 +5152,7 @@ (in_meta (list (` [(~ location_code) (#.Text (~ (|> tokens (list\map (|>> ..documentation_fragment ..fragment_documentation)) - (text\join_with "") + (text\interposed "") text$)))])))) (def: (interleaved xs ys) @@ -5324,7 +5314,7 @@ [[location ( elems)] (do maybe_monad [placements (monad\map maybe_monad (with_expansions' label tokens) elems)] - (in (list [location ( (list\join placements))])))]) + (in (list [location ( (list\joined placements))])))]) ([#Tuple] [#Form]) @@ -5973,7 +5963,7 @@ .let [[labels labelled] =raw]] (in (list (` (with_expansions [(~+ (|> labels (list\map (function (_ [label expansion]) (list label expansion))) - list\join))] + list\joined))] (~ labelled)))))) _ -- cgit v1.2.3