diff options
Diffstat (limited to 'stdlib/source/library/lux.lux')
| -rw-r--r-- | stdlib/source/library/lux.lux | 1655 |
1 files changed, 860 insertions, 795 deletions
diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux index ffe7daf46..9770f131c 100644 --- a/stdlib/source/library/lux.lux +++ b/stdlib/source/library/lux.lux @@ -837,7 +837,7 @@ _ (failure "Wrong syntax for let''")} tokens))) - (record$ #.End) + (record$ #End) #0) ("lux def" function'' @@ -874,7 +874,7 @@ _ (failure "Wrong syntax for function''")} tokens))) - (record$ #.End) + (record$ #End) #0) ("lux def" location_code @@ -959,7 +959,7 @@ _ (failure "Wrong syntax for def''")} tokens))) - (record$ #.End) + (record$ #End) #0) ("lux def" macro:' @@ -984,7 +984,7 @@ _ (failure "Wrong syntax for macro:'")} tokens))) - (record$ #.End) + (record$ #End) #0) (macro:' .public (comment tokens) @@ -1012,7 +1012,7 @@ (failure "Wrong syntax for $'")} tokens)) -(def:'' .private (list\map f xs) +(def:'' .private (list\each f xs) #End (#UnivQ #End (#UnivQ #End @@ -1023,7 +1023,7 @@ #End (#Item x xs') - (#Item (f x) (list\map f xs'))} + (#Item (f x) (list\each f xs'))} xs)) (def:'' .private Replacement_Environment @@ -1073,25 +1073,25 @@ (..replacement name reps)) [meta (#Form parts)] - [meta (#Form (list\map (with_replacements reps) parts))] + [meta (#Form (list\each (with_replacements reps) parts))] [meta (#Tuple members)] - [meta (#Tuple (list\map (with_replacements reps) members))] + [meta (#Tuple (list\each (with_replacements reps) members))] [meta (#Record slots)] - [meta (#Record (list\map ("lux type check" (#Function (#Product Code Code) (#Product Code Code)) - (function'' [slot] - ({[k v] - [(with_replacements reps k) (with_replacements reps v)]} - slot))) - slots))] + [meta (#Record (list\each ("lux type check" (#Function (#Product Code Code) (#Product Code Code)) + (function'' [slot] + ({[k v] + [(with_replacements reps k) (with_replacements reps v)]} + slot))) + slots))] _ syntax} syntax)) (def:'' .private (n/* param subject) - #.End + #End (#Function Nat (#Function Nat Nat)) ("lux type as" Nat ("lux i64 *" @@ -1102,20 +1102,20 @@ #End (#Function Code Code) ({[_ (#Tuple members)] - (tuple$ (list\map nested_quantification members)) + (tuple$ (list\each nested_quantification members)) [_ (#Record pairs)] - (record$ (list\map ("lux type check" (#Function (#Product Code Code) (#Product Code Code)) - (function'' [pair] - (let'' [name val] pair - [name (nested_quantification val)]))) - pairs)) + (record$ (list\each ("lux type check" (#Function (#Product Code Code) (#Product Code Code)) + (function'' [pair] + (let'' [name val] pair + [name (nested_quantification val)]))) + pairs)) [_ (#Form (#Item [_ (#Tag "library/lux" "Parameter")] (#Item [_ (#Nat idx)] #End)))] (form$ (#Item (tag$ ["library/lux" "Parameter"]) (#Item (nat$ ("lux i64 +" 2 idx)) #End))) [_ (#Form members)] - (form$ (list\map nested_quantification members)) + (form$ (list\each nested_quantification members)) _ code} @@ -1173,7 +1173,7 @@ ("lux text concat" "(All [a] (-> a a))" __paragraph) ("lux text concat" ("lux text concat" "... A name can be provided, to specify a recursive type." __paragraph) - "(All List [a] (Variant Any [a (List a)]))"))))] + "(All List [a] (Union Any [a (List a)]))"))))] #End) (let'' [self_name tokens] ({(#Item [_ (#Identifier "" self_name)] tokens) [self_name tokens] @@ -1315,15 +1315,15 @@ (failure "Wrong syntax for list&")} (list\reversed xs))) -(macro:' .public (Variant tokens) +(macro:' .public (Union tokens) (#Item [(tag$ ["library/lux" "doc"]) (text$ ("lux text concat" - ("lux text concat" "... Variant types:" __paragraph) + ("lux text concat" "... Union types:" __paragraph) ("lux text concat" - ("lux text concat" "(Variant Text Int Bit)" __paragraph) + ("lux text concat" "(Union Text Int Bit)" __paragraph) ("lux text concat" ("lux text concat" "... Nothing." __paragraph) - "(Variant)"))))] + "(Union)"))))] #End) ({#End (in_meta (list (identifier$ ["library/lux" "Nothing"]))) @@ -1413,10 +1413,10 @@ (def:''' .public Or (#Item [(tag$ ["library/lux" "doc"]) - (text$ "An alias for the Variant type constructor.")] + (text$ "An alias for the Union type constructor.")] #End) Macro - ..Variant) + ..Union) (def:''' .public And (#Item [(tag$ ["library/lux" "doc"]) @@ -1479,11 +1479,11 @@ (_ann (#Form (list (_ann (#Tag ["library/lux" "Item"])) token (untemplated_list tokens'))))} tokens)) -(def:''' .private (list\compose xs ys) +(def:''' .private (list\composite xs ys) #End (All [a] (-> ($' List a) ($' List a) ($' List a))) ({(#Item x xs') - (#Item x (list\compose xs' ys)) + (#Item x (list\composite xs' ys)) #End ys} @@ -1493,7 +1493,7 @@ #End (-> Code Code Code Code) ({[_ (#Form parts)] - (form$ (list\compose parts (list a1 a2))) + (form$ (list\composite parts (list a1 a2))) _ (form$ (list op a1 a2))} @@ -1511,10 +1511,10 @@ (text$ ("lux text concat" ("lux text concat" "... Left-association for the application of binary functions over variadic arguments." ..\n) ("lux text concat" - ("lux text concat" "(_$ text\compose ''Hello, '' name ''. How are you?'')" ..\n) + ("lux text concat" "(_$ text\composite ''Hello, '' name ''. How are you?'')" ..\n) ("lux text concat" ("lux text concat" "... =>" ..\n) - "(text\compose (text\compose ''Hello, '' name) ''. How are you?'')"))))] + "(text\composite (text\composite ''Hello, '' name) ''. How are you?'')"))))] #End) ({(#Item op tokens') ({(#Item first nexts) @@ -1533,10 +1533,10 @@ (text$ ("lux text concat" ("lux text concat" "... Right-association for the application of binary functions over variadic arguments." ..\n) ("lux text concat" - ("lux text concat" "($_ text\compose ''Hello, '' name ''. How are you?'')" ..\n) + ("lux text concat" "($_ text\composite ''Hello, '' name ''. How are you?'')" ..\n) ("lux text concat" ("lux text concat" "... =>" ..\n) - "(text\compose ''Hello, '' (text\compose name ''. How are you?''))"))))] + "(text\composite ''Hello, '' (text\composite name ''. How are you?''))"))))] #End) ({(#Item op tokens') ({(#Item last prevs) @@ -1629,7 +1629,7 @@ (failure "Wrong syntax for do")} tokens)) -(def:''' .private (monad\map m f xs) +(def:''' .private (monad\each m f xs) #End ... (All [m a b] ... (-> (Monad m) (-> a (m b)) (List a) (m (List b)))) @@ -1645,7 +1645,7 @@ (#Item x xs') (do m [y (f x) - ys (monad\map m f xs')] + ys (monad\each m f xs')] (in (#Item y ys)))} xs))) @@ -1702,7 +1702,7 @@ #None} plist)) -(def:''' .private (text\compose x y) +(def:''' .private (text\composite x y) #End (-> Text Text Text) ("lux text concat" x y)) @@ -1712,7 +1712,7 @@ (-> Name Text) (let' [[module name] full_name] ({"" name - _ ($_ text\compose module "." name)} + _ ($_ text\composite module "." name)} module))) (def:''' .private (global_identifier full_name state) @@ -1733,11 +1733,11 @@ constant) #None - (#Left ($_ text\compose "Unknown definition: " (name\encoded full_name)))} + (#Left ($_ text\composite "Unknown definition: " (name\encoded full_name)))} (plist\value name definitions)) #None - (#Left ($_ text\compose "Unknown module: " module " @ " (name\encoded full_name)))} + (#Left ($_ text\composite "Unknown module: " module " @ " (name\encoded full_name)))} (plist\value module modules)))) (def:''' .private (code_list expression) @@ -1771,7 +1771,7 @@ ({[_ (#Form (#Item [[_ (#Identifier ["" "~+"])] (#Item [spliced #End])]))] (let' [g!in-module (form$ (list (text$ "lux in-module") (text$ "library/lux") - (identifier$ ["library/lux" "list\compose"])))] + (identifier$ ["library/lux" "list\composite"])))] (in (form$ (list g!in-module (code_list spliced) rightO)))) _ @@ -1784,7 +1784,7 @@ (list\reversed elems)) #0 (do meta_monad - [=elems (monad\map meta_monad untemplated elems)] + [=elems (monad\each meta_monad untemplated elems)] (in (untemplated_list =elems)))} replace?)) @@ -1872,15 +1872,15 @@ [_ [_ (#Record fields)]] (do meta_monad - [=fields (monad\map meta_monad - ("lux type check" (-> (Tuple Code Code) ($' Meta Code)) - (function' [kv] - (let' [[k v] kv] - (do meta_monad - [=k (untemplated replace? subst k) - =v (untemplated replace? subst v)] - (in (tuple$ (list =k =v))))))) - fields)] + [=fields (monad\each meta_monad + ("lux type check" (-> (Tuple Code Code) ($' Meta Code)) + (function' [kv] + (let' [[k v] kv] + (do meta_monad + [=k (untemplated replace? subst k) + =v (untemplated replace? subst v)] + (in (tuple$ (list =k =v))))))) + fields)] (in (with_location (form$ (list (tag$ ["library/lux" "Record"]) (untemplated_list =fields))))))} [replace? token])) @@ -1965,17 +1965,17 @@ (list [(tag$ ["library/lux" "doc"]) (text$ ($_ "lux text concat" "... Piping macro." __paragraph - "(|> elems (list\map int\encoded) (interposed '' '') (mix text\compose ''''))" __paragraph + "(|> elems (list\each int\encoded) (interposed '' '') (mix text\composite ''''))" __paragraph "... =>" __paragraph - "(mix text\compose '''' (interposed '' '' (list\map int\encoded elems)))"))]) + "(mix text\composite '''' (interposed '' '' (list\each int\encoded elems)))"))]) ({(#Item [init apps]) (in_meta (list (list\mix ("lux type check" (-> Code Code Code) (function' [app acc] ({[_ (#Tuple parts)] - (tuple$ (list\compose parts (list acc))) + (tuple$ (list\composite parts (list acc))) [_ (#Form parts)] - (form$ (list\compose parts (list acc))) + (form$ (list\composite parts (list acc))) _ (` ((~ app) (~ acc)))} @@ -1991,17 +1991,17 @@ (list [(tag$ ["library/lux" "doc"]) (text$ ($_ "lux text concat" "... Reverse piping macro." __paragraph - "(<| (mix text\compose '''') (interposed '' '') (list\map int\encoded) elems)" __paragraph + "(<| (mix text\composite '''') (interposed '' '') (list\each int\encoded) elems)" __paragraph "... =>" __paragraph - "(mix text\compose '''' (interposed '' '' (list\map int\encoded elems)))"))]) + "(mix text\composite '''' (interposed '' '' (list\each int\encoded elems)))"))]) ({(#Item [init apps]) (in_meta (list (list\mix ("lux type check" (-> Code Code Code) (function' [app acc] ({[_ (#Tuple parts)] - (tuple$ (list\compose parts (list acc))) + (tuple$ (list\composite parts (list acc))) [_ (#Form parts)] - (form$ (list\compose parts (list acc))) + (form$ (list\composite parts (list acc))) _ (` ((~ app) (~ acc)))} @@ -2072,17 +2072,17 @@ (..replacement sname env)) [meta (#Tuple elems)] - [meta (#Tuple (list\map (realized_template env) elems))] + [meta (#Tuple (list\each (realized_template env) elems))] [meta (#Form elems)] - [meta (#Form (list\map (realized_template env) elems))] + [meta (#Form (list\each (realized_template env) elems))] [meta (#Record members)] - [meta (#Record (list\map ("lux type check" (-> (Tuple Code Code) (Tuple Code Code)) - (function' [kv] - (let' [[slot value] kv] - [(realized_template env slot) (realized_template env value)]))) - members))] + [meta (#Record (list\each ("lux type check" (-> (Tuple Code Code) (Tuple Code Code)) + (function' [kv] + (let' [[slot value] kv] + [(realized_template env slot) (realized_template env value)]))) + members))] _ template} @@ -2129,11 +2129,11 @@ #1 ("lux i64 =" reference sample))) -(def:''' .private (list\joined xs) +(def:''' .private (list\conjoint xs) #End (All [a] (-> ($' List ($' List a)) ($' List a))) - (list\mix list\compose #End (list\reversed xs))) + (list\mix list\composite #End (list\reversed xs))) (macro:' .public (template tokens) (list [(tag$ ["library/lux" "doc"]) @@ -2146,20 +2146,20 @@ ({(#Item [[_ (#Tuple bindings)] (#Item [[_ (#Tuple templates)] data])]) ({[(#Some bindings') (#Some data')] (let' [apply ("lux type check" (-> Replacement_Environment ($' List Code)) - (function' [env] (list\map (realized_template env) templates))) + (function' [env] (list\each (realized_template env) templates))) num_bindings (list\size bindings')] (if (every? (function' [size] ("lux i64 =" num_bindings size)) - (list\map list\size data')) + (list\each list\size data')) (|> data' - (list\map (function\composite apply (replacement_environment bindings'))) - list\joined + (list\each (function\composite apply (replacement_environment bindings'))) + list\conjoint in_meta) (failure "Irregular arguments tuples for template."))) _ (failure "Wrong syntax for template")} - [(monad\map maybe_monad identifier_short bindings) - (monad\map maybe_monad tuple_list data)]) + [(monad\each maybe_monad identifier_short bindings) + (monad\each maybe_monad tuple_list data)]) _ (failure "Wrong syntax for template")} @@ -2226,8 +2226,8 @@ (if ("lux i64 =" 0 input) output (recur (n// 10 input) - (text\compose (|> input (n/% 10) digit::format) - output)))))] + (text\composite (|> input (n/% 10) digit::format) + output)))))] (loop value ""))} value)) @@ -2249,10 +2249,10 @@ (("lux type check" (-> Int Text Text) (function' recur [input output] (if ("lux i64 =" +0 input) - (text\compose sign output) + (text\composite sign output) (recur ("lux i64 /" +10 input) - (text\compose (|> input ("lux i64 %" +10) ("lux type as" Nat) digit::format) - output))))) + (text\composite (|> input ("lux i64 %" +10) ("lux type as" Nat) digit::format) + output))))) (|> value ("lux i64 /" +10) int\abs) (|> value ("lux i64 %" +10) int\abs ("lux type as" Nat) digit::format))))) @@ -2386,8 +2386,8 @@ ({(#Some macro) (do meta_monad [top_level_expansion (("lux type as" Macro' macro) args) - recursive_expansion (monad\map meta_monad expansion top_level_expansion)] - (in (list\joined recursive_expansion))) + recursive_expansion (monad\each meta_monad expansion top_level_expansion)] + (in (list\conjoint recursive_expansion))) #None (in_meta (list token))} @@ -2407,53 +2407,112 @@ ({(#Some macro) (do meta_monad [expansion (("lux type as" Macro' macro) args) - expansion' (monad\map meta_monad full_expansion expansion)] - (in (list\joined expansion'))) + expansion' (monad\each meta_monad full_expansion expansion)] + (in (list\conjoint expansion'))) #None (do meta_monad - [args' (monad\map meta_monad full_expansion args)] - (in (list (form$ (#Item (identifier$ name) (list\joined args'))))))} + [args' (monad\each meta_monad full_expansion args)] + (in (list (form$ (#Item (identifier$ name) (list\conjoint args'))))))} ?macro)) [_ (#Form members)] (do meta_monad - [members' (monad\map meta_monad full_expansion members)] - (in (list (form$ (list\joined members'))))) + [members' (monad\each meta_monad full_expansion members)] + (in (list (form$ (list\conjoint members'))))) [_ (#Tuple members)] (do meta_monad - [members' (monad\map meta_monad full_expansion members)] - (in (list (tuple$ (list\joined members'))))) + [members' (monad\each meta_monad full_expansion members)] + (in (list (tuple$ (list\conjoint members'))))) [_ (#Record pairs)] (do meta_monad - [pairs' (monad\map meta_monad - (function' [kv] - (let' [[key val] kv] - (do meta_monad - [val' (full_expansion val)] - ({(#Item val'' #End) - (in_meta [key val'']) + [pairs' (monad\each meta_monad + (function' [kv] + (let' [[key val] kv] + (do meta_monad + [val' (full_expansion val)] + ({(#Item val'' #End) + (in_meta [key val'']) - _ - (failure "The value-part of a KV-pair in a record must macro-expand to a single Code.")} - val')))) - pairs)] + _ + (failure "The value-part of a KV-pair in a record must macro-expand to a single Code.")} + val')))) + pairs)] (in (list (record$ pairs')))) _ (in_meta (list syntax))} syntax)) +(def:''' .private (text\encoded original) + #End + (-> Text Text) + ($_ text\composite ..double_quote original ..double_quote)) + +(def:''' .private (code\encoded code) + #End + (-> Code Text) + ({[_ (#Bit value)] + (bit\encoded value) + + [_ (#Nat value)] + (nat\encoded value) + + [_ (#Int value)] + (int\encoded value) + + [_ (#Rev value)] + ("lux io error" "@code\encoded Undefined behavior.") + + [_ (#Frac value)] + (frac\encoded value) + + [_ (#Text value)] + (text\encoded value) + + [_ (#Identifier [module name])] + (if (text\= "" module) + name + ($_ text\composite module "." name)) + + [_ (#Tag [module name])] + (if (text\= "" module) + ($_ text\composite "#" name) + ($_ text\composite "#" module "." name)) + + [_ (#Form xs)] + ($_ text\composite "(" (|> xs + (list\each code\encoded) + (list\interposed " ") + list\reversed + (list\mix text\composite "")) ")") + + [_ (#Tuple xs)] + ($_ text\composite "[" (|> xs + (list\each code\encoded) + (list\interposed " ") + list\reversed + (list\mix text\composite "")) "]") + + [_ (#Record kvs)] + ($_ text\composite "{" (|> kvs + (list\each (function' [kv] ({[k v] ($_ text\composite (code\encoded k) " " (code\encoded v))} + kv))) + (list\interposed " ") + list\reversed + (list\mix text\composite "")) "}")} + code)) + (def:''' .private (normal_type type) #End (-> Code Code) ({[_ (#Form (#Item [_ (#Tag tag)] parts))] - (form$ (#Item [(tag$ tag) (list\map normal_type parts)])) + (form$ (#Item (tag$ tag) (list\each normal_type parts))) [_ (#Tuple members)] - (` (Tuple (~+ (list\map normal_type members)))) + (` (Tuple (~+ (list\each normal_type members)))) [_ (#Form (#Item [_ (#Text "lux in-module")] (#Item [_ (#Text module)] @@ -2468,8 +2527,8 @@ (list\mix ("lux type check" (-> Code Code Code) (function' [arg type_fn] (` (#.Apply (~ arg) (~ type_fn))))) (normal_type type_fn) - (list\map normal_type args)) - + (list\each normal_type args)) + _ type} type)) @@ -2484,7 +2543,7 @@ [type+ (full_expansion type)] ({(#Item type' #End) (in (list (normal_type type'))) - + _ (failure "The expansion of the type-syntax had to yield a single element.")} type+)) @@ -2534,60 +2593,6 @@ [product\left a x] [product\right b y]) -(def:''' .private (type_declaration type_codes) - #End - (-> ($' List Code) ($' Meta (Tuple Code ($' Maybe ($' List Text))))) - ({(#Item [_ (#Record pairs)] #End) - (do meta_monad - [members (monad\map meta_monad - (: (-> [Code Code] (Meta [Text Code])) - (function' [pair] - ({[[_ (#Tag "" member_name)] member_type] - (in_meta [member_name member_type]) - - _ - (failure "Wrong syntax for variant case.")} - pair))) - pairs)] - (in_meta [(` (Tuple (~+ (list\map product\right members)))) - (#Some (list\map product\left members))])) - - (#Item type #End) - ({[_ (#Tag "" member_name)] - (in_meta [(` .Any) (#Some (list member_name))]) - - [_ (#Form (#Item [_ (#Tag "" member_name)] member_types))] - (in_meta [(` (Tuple (~+ member_types))) (#Some (list member_name))]) - - _ - (in_meta [type #None])} - type) - - (#Item case cases) - (do meta_monad - [members (monad\map meta_monad - (: (-> Code (Meta [Text Code])) - (function' [case] - ({[_ (#Tag "" member_name)] - (in_meta [member_name (` .Any)]) - - [_ (#Form (#Item [_ (#Tag "" member_name)] (#Item member_type #End)))] - (in_meta [member_name member_type]) - - [_ (#Form (#Item [_ (#Tag "" member_name)] member_types))] - (in_meta [member_name (` (Tuple (~+ member_types)))]) - - _ - (failure "Wrong syntax for variant case.")} - case))) - (list& case cases))] - (in_meta [(` (..Variant (~+ (list\map product\right members)))) - (#Some (list\map product\left members))])) - - _ - (failure "Improper type-definition syntax")} - type_codes)) - (def:''' .private (identifier prefix state) #End (-> Text ($' Meta Code)) @@ -2601,7 +2606,7 @@ #seed ("lux i64 +" 1 seed) #expected expected #location location #extensions extensions #scope_type_vars scope_type_vars #eval _eval} - (local_identifier$ ($_ text\compose "__gensym__" prefix (nat\encoded seed))))} + (local_identifier$ ($_ text\composite "__gensym__" prefix (nat\encoded seed))))} state)) (macro:' .public (Rec tokens) @@ -2681,63 +2686,6 @@ (failure "Wrong syntax for def'")} parts))) -(def:' .private (text\encoded original) - (-> Text Text) - ($_ text\compose ..double_quote original ..double_quote)) - -(def:' .private (code\encoded code) - (-> Code Text) - ({[_ (#Bit value)] - (bit\encoded value) - - [_ (#Nat value)] - (nat\encoded value) - - [_ (#Int value)] - (int\encoded value) - - [_ (#Rev value)] - ("lux io error" "@code\encoded Undefined behavior.") - - [_ (#Frac value)] - (frac\encoded value) - - [_ (#Text value)] - (text\encoded value) - - [_ (#Identifier [module name])] - (if (text\= "" module) - name - ($_ text\compose module "." name)) - - [_ (#Tag [module name])] - (if (text\= "" module) - ($_ text\compose "#" name) - ($_ text\compose "#" module "." name)) - - [_ (#Form xs)] - ($_ text\compose "(" (|> xs - (list\map code\encoded) - (list\interposed " ") - list\reversed - (list\mix text\compose "")) ")") - - [_ (#Tuple xs)] - ($_ text\compose "[" (|> xs - (list\map code\encoded) - (list\interposed " ") - list\reversed - (list\mix text\compose "")) "]") - - [_ (#Record kvs)] - ($_ text\compose "{" (|> kvs - (list\map (function' [kv] ({[k v] ($_ text\compose (code\encoded k) " " (code\encoded v))} - kv))) - (list\interposed " ") - list\reversed - (list\mix text\compose "")) "}")} - code)) - (def:' .private (expander branches) (-> (List Code) (Meta (List Code))) ({(#Item [_ (#Form (#Item [_ (#Identifier name)] args))] @@ -2764,11 +2712,11 @@ (do meta_monad [] (in (list))) _ - (failure ($_ text\compose "'lux.case' expects an even number of tokens: " (|> branches - (list\map code\encoded) - (list\interposed " ") - list\reversed - (list\mix text\compose ""))))} + (failure ($_ text\composite "'lux.case' expects an even number of tokens: " (|> branches + (list\each code\encoded) + (list\interposed " ") + list\reversed + (list\mix text\composite ""))))} branches)) (macro:' .public (case tokens) @@ -2838,9 +2786,9 @@ _ (let' [pairs (|> patterns - (list\map (function' [pattern] (list pattern body))) - (list\joined))] - (in_meta (list\compose pairs branches)))) + (list\each (function' [pattern] (list pattern body))) + (list\conjoint))] + (in_meta (list\composite pairs branches)))) _ (failure "Wrong syntax for ^or"))) @@ -2940,27 +2888,27 @@ [_ (#Tuple xs)] (|> xs - (list\map definition_annotation_value) + (list\each definition_annotation_value) untemplated_list (meta_code ["library/lux" "Tuple"])) [_ (#Record kvs)] (|> kvs - (list\map (: (-> [Code Code] Code) - (function (_ [k v]) - (` [(~ (definition_annotation_value k)) - (~ (definition_annotation_value v))])))) + (list\each (: (-> [Code Code] Code) + (function (_ [k v]) + (` [(~ (definition_annotation_value k)) + (~ (definition_annotation_value v))])))) untemplated_list (meta_code ["library/lux" "Record"])) )) (def:' .private (definition_annotations kvs) (-> (List [Code Code]) Code) - (untemplated_list (list\map (: (-> [Code Code] Code) - (function (_ [k v]) - (` [(~ (definition_annotation_value k)) - (~ (definition_annotation_value v))]))) - kvs))) + (untemplated_list (list\each (: (-> [Code Code] Code) + (function (_ [k v]) + (` [(~ (definition_annotation_value k)) + (~ (definition_annotation_value v))]))) + kvs))) (def:' .private (with_function_parameters parameters meta) (-> (List Code) Code Code) @@ -2970,21 +2918,21 @@ _ (` (#.Item [[(~ location_code) (#.Tag ["library/lux" "func_args"])] - [(~ location_code) (#.Tuple (.list (~+ (list\map (function (_ parameter) - (` [(~ location_code) (#.Text (~ (text$ (code\encoded parameter))))])) - parameters))))]] + [(~ location_code) (#.Tuple (.list (~+ (list\each (function (_ parameter) + (` [(~ location_code) (#.Text (~ (text$ (code\encoded parameter))))])) + parameters))))]] (~ meta))))) (def:' .private (with_type_args args) (-> (List Code) Code) - (` {#.type_args [(~+ (list\map (function (_ arg) (text$ (code\encoded arg))) - args))]})) + (` {#.type_args [(~+ (list\each (function (_ arg) (text$ (code\encoded arg))) + args))]})) (def:' .private (endP tokens) (-> (List Code) (Maybe Any)) (case tokens (^ (list)) - (#.Some []) + (#Some []) _ #None)) @@ -2996,7 +2944,7 @@ (#Some [tokens' code]) _ - #.None)) + #None)) (def:' .private (local_identifierP tokens) (-> (List Code) (Maybe [(List Code) Text])) @@ -3005,14 +2953,14 @@ (#Some [tokens' local_identifier]) _ - #.None)) + #None)) (template [<parser> <item_type> <item_parser>] [(def:' .private (<parser> tokens) (-> (List Code) (Maybe (List <item_type>))) (case tokens #End - (#.Some #End) + (#Some #End) _ (do maybe_monad @@ -3264,7 +3212,7 @@ _ (` ("lux macro" - (function ((~ name) (~+ (list\map local_identifier$ args))) (~ body))))) + (function ((~ name) (~+ (list\each local_identifier$ args))) (~ body))))) =annotations (definition_annotations annotations)] (in_meta (list (` ("lux def" (~ name) (~ body) @@ -3272,7 +3220,7 @@ (#Record (~ =annotations))] (~ export_policy)))))) - #.None + #None (failure "Wrong syntax for macro:"))) (def: (list\one f xs) @@ -3496,7 +3444,7 @@ (#Right state module) _ - (#Left ($_ text\compose "Unknown module: " name)))))) + (#Left ($_ text\composite "Unknown module: " name)))))) (def: (type_tag [module name]) (-> Name (Meta [Nat (List Name) Bit Type])) @@ -3508,7 +3456,7 @@ (in_meta output) _ - (failure (text\compose "Unknown tag: " (name\encoded [module name])))))) + (failure (text\composite "Unknown tag: " (name\encoded [module name])))))) (def: (record_slots type) (-> Type (Meta (Maybe [(List Name) (List Type)]))) @@ -3573,7 +3521,7 @@ " (= test subject)))" ..\n " ))"))} (do meta_monad - [tokens' (monad\map meta_monad expansion tokens) + [tokens' (monad\each meta_monad expansion tokens) struct_type ..expected_type tags+type (record_slots struct_type) tags (: (Meta (List Name)) @@ -3584,23 +3532,23 @@ _ (failure "No tags available for type."))) .let [tag_mappings (: (List [Text Code]) - (list\map (function (_ tag) [(product\right tag) (tag$ tag)]) - tags))] - members (monad\map meta_monad - (: (-> Code (Meta [Code Code])) - (function (_ token) - (case token - (^ [_ (#Form (list [_ (#Text "lux def")] [_ (#Identifier "" tag_name)] value meta export_policy))]) - (case (plist\value tag_name tag_mappings) - (#Some tag) - (in [tag value]) + (list\each (function (_ tag) [(product\right tag) (tag$ tag)]) + tags))] + members (monad\each meta_monad + (: (-> Code (Meta [Code Code])) + (function (_ token) + (case token + (^ [_ (#Form (list [_ (#Text "lux def")] [_ (#Identifier "" tag_name)] value meta export_policy))]) + (case (plist\value tag_name tag_mappings) + (#Some tag) + (in [tag value]) - _ - (failure (text\compose "Unknown implementation member: " tag_name))) + _ + (failure (text\composite "Unknown implementation member: " tag_name))) - _ - (failure "Invalid implementation member.")))) - (list\joined tokens'))] + _ + (failure "Invalid implementation member.")))) + (list\conjoint tokens'))] (in (list (record$ members))))) (def: (text\interposed separator parts) @@ -3611,7 +3559,7 @@ (#Item head tail) (list\mix (function (_ right left) - ($_ text\compose left separator right)) + ($_ text\composite left separator right)) head tail))) @@ -3695,6 +3643,83 @@ (All [a] (-> a a)) value) +(def: (everyP itP tokens) + (All [a] (-> (-> (List Code) (Maybe [(List Code) a])) + (-> (List Code) (Maybe (List a))))) + (case tokens + (#Item _) + (do maybe_monad + [% (itP tokens) + .let [[tokens' head] %] + tail (case tokens' + (#Item _) + (everyP itP tokens') + + #End + (in (list)))] + (in (list& head tail))) + + #End + (#Some (list)))) + +(def: (caseP tokens) + (-> (List Code) (Maybe [(List Code) [Text Code]])) + (case tokens + (^ (list& [_ (#Tag ["" niladic])] tokens')) + (#Some [tokens' [niladic (` .Any)]]) + + (^ (list& [_ (#Form (list& [_ (#Tag ["" polyadic])] caseT))] tokens')) + (#Some [tokens' [polyadic (` (..Tuple (~+ caseT)))]]) + + _ + #None)) + +(macro: .public (Variant tokens) + (case (everyP caseP tokens) + (#Some cases) + (in_meta (list (` (..Union (~+ (list\each product\right cases)))) + (tuple$ (list\each (function (_ case) + (text$ (product\left case))) + cases)))) + + #None + (failure "Wrong syntax for Variant"))) + +(def: (slotP tokens) + (-> (List Code) (Maybe [(List Code) [Text Code]])) + (case tokens + (^ (list& [_ (#Tag ["" slot])] type tokens')) + (#Some [tokens' [slot type]]) + + _ + #.None)) + +(def: un_paired + (-> (List [Code Code]) (List Code)) + (let [pair_list (: (-> [Code Code] (List Code)) + (function (_ [left right]) + (list left right)))] + (function (_ it) + (|> it + (list\each pair_list) + list\conjoint)))) + +(macro: .public (Record tokens) + (case tokens + (^ (list [_ (#Record record)])) + (case (everyP slotP (un_paired record)) + (#Some slots) + (in_meta (list (` (..Tuple (~+ (list\each product\right slots)))) + (tuple$ (list\each (function (_ slot) + (text$ (product\left slot))) + slots)))) + + #None + (failure "Wrong syntax for Record")) + + _ + (failure "Wrong syntax for Record"))) + (def: (recP tokens) (-> (List Code) [(List Code) Bit]) (case tokens @@ -3704,49 +3729,90 @@ _ [tokens #0])) -(def:' .private (typeP tokens) - (-> (List Code) (Maybe [Code Bit Text (List Text) (List [Code Code]) (List Code)])) - (|> (do maybe_monad - [% (anyP tokens) - .let' [[tokens export_policy] %] - .let' [[tokens rec?] (recP tokens)] - % (local_declarationP tokens) - .let' [[tokens [name parameters]] %] - % (annotationsP tokens) - .let' [[tokens annotations] %] - tokens (remainderP tokens)] - (in [export_policy rec? name parameters annotations tokens])) - ... (^ (list _export_policy _rec _declaration _annotations _body)) - ... (^ (list _export_policy _declaration _annotations _body)) - (maybe\else' (do maybe_monad - [.let' [[tokens rec?] (recP tokens)] - % (local_declarationP tokens) - .let' [[tokens [name parameters]] %] - % (annotationsP tokens) - .let' [[tokens annotations] %] - tokens (remainderP tokens)] - (in [(` ..private) rec? name parameters annotations tokens]))) - ... (^ (list _rec _declaration _annotations _body)) - ... (^ (list _declaration _annotations _body)) - (maybe\else' (do maybe_monad - [.let' [[tokens rec?] (recP tokens)] - % (local_declarationP tokens) - .let' [[tokens [name parameters]] %] - tokens (remainderP tokens)] - (in [(` ..private) rec? name parameters #End tokens]))) - ... (^ (list _rec _declaration _body)) - ... (^ (list _declaration _body)) - (maybe\else' (do maybe_monad - [% (anyP tokens) - .let' [[tokens export_policy] %] - .let' [[tokens rec?] (recP tokens)] - % (local_declarationP tokens) - .let' [[tokens [name parameters]] %] - tokens (remainderP tokens)] - (in [export_policy rec? name parameters #End tokens]))) - ... (^ (list _export_policy _rec _declaration _body)) - ... (^ (list _export_policy _declaration _body)) - )) +(def: (typeP tokens) + (-> (List Code) (Maybe [Code Bit Text (List Text) (List [Code Code]) Code])) + (|> (do maybe_monad + [% (anyP tokens) + .let' [[tokens export_policy] %] + .let' [[tokens rec?] (recP tokens)] + % (local_declarationP tokens) + .let' [[tokens [name parameters]] %] + % (annotationsP tokens) + .let' [[tokens annotations] %] + % (anyP tokens) + .let' [[tokens definition] %] + _ (endP tokens)] + (in [export_policy rec? name parameters annotations definition])) + ... (^ (list _export_policy _rec _declaration _annotations _body)) + ... (^ (list _export_policy _declaration _annotations _body)) + (maybe\else' (do maybe_monad + [.let' [[tokens rec?] (recP tokens)] + % (local_declarationP tokens) + .let' [[tokens [name parameters]] %] + % (annotationsP tokens) + .let' [[tokens annotations] %] + % (anyP tokens) + .let' [[tokens definition] %] + _ (endP tokens)] + (in [(` ..private) rec? name parameters annotations definition]))) + ... (^ (list _rec _declaration _annotations _body)) + ... (^ (list _declaration _annotations _body)) + (maybe\else' (do maybe_monad + [.let' [[tokens rec?] (recP tokens)] + % (local_declarationP tokens) + .let' [[tokens [name parameters]] %] + % (anyP tokens) + .let' [[tokens definition] %] + _ (endP tokens)] + (in [(` ..private) rec? name parameters #End definition]))) + ... (^ (list _rec _declaration _body)) + ... (^ (list _declaration _body)) + (maybe\else' (do maybe_monad + [% (anyP tokens) + .let' [[tokens export_policy] %] + .let' [[tokens rec?] (recP tokens)] + % (local_declarationP tokens) + .let' [[tokens [name parameters]] %] + % (anyP tokens) + .let' [[tokens definition] %] + _ (endP tokens)] + (in [export_policy rec? name parameters #End definition]))) + ... (^ (list _export_policy _rec _declaration _body)) + ... (^ (list _export_policy _declaration _body)) + )) + +(def: (textP tokens) + (-> (List Code) (Maybe [(List Code) Text])) + (case tokens + (^ (list& [_ (#Text it)] tokens')) + (#Some [tokens' it]) + + _ + #None)) + +(def: (type_declaration it) + (-> Code (Meta (Tuple Code (Maybe (List Text))))) + ({[_ (#Form (#Item [_ (#Identifier declarer)] parameters))] + (do meta_monad + [declaration (single_expansion (form$ (list& (identifier$ declarer) parameters)))] + (case declaration + (^ (list type [_ (#Tuple tags)])) + (case (everyP textP tags) + (#Some tags) + (in_meta [type (#Some tags)]) + + #None + (failure "Improper type-definition syntax")) + + (^ (list type)) + (in_meta [it #None]) + + _ + (failure "Improper type-definition syntax"))) + + type + (in_meta [type #None])} + it)) (macro: .public (type: tokens) {#.doc (text$ ($_ "lux text concat" @@ -3759,53 +3825,53 @@ (#Some [export_policy rec? name args meta type_codes]) (do meta_monad [type+tags?? (..type_declaration type_codes) - module_name current_module_name] - (let [type_name (local_identifier$ name) - [type tags??] type+tags?? - type' (: (Maybe Code) - (if rec? - (if (empty? args) - (let [g!param (local_identifier$ "") - prime_name (local_identifier$ name) - type+ (with_replacements (list [name (` ((~ prime_name) .Nothing))]) - type)] - (#Some (` ((All (~ prime_name) [(~ g!param)] (~ type+)) - .Nothing)))) - #None) - (case args - #End - (#Some type) + module_name current_module_name + .let' [type_name (local_identifier$ name) + [type tags??] type+tags?? + type' (: (Maybe Code) + (if rec? + (if (empty? args) + (let [g!param (local_identifier$ "") + prime_name (local_identifier$ name) + type+ (with_replacements (list [name (` ((~ prime_name) .Nothing))]) + type)] + (#Some (` ((All (~ prime_name) [(~ g!param)] (~ type+)) + .Nothing)))) + #None) + (case args + #End + (#Some type) - _ - (#Some (` (.All (~ type_name) [(~+ (list\map local_identifier$ args))] (~ type))))))) - total_meta (let [meta (definition_annotations meta) - meta (if rec? - (` (#.Item (~ (flag_meta "type_rec?")) (~ meta))) - meta)] - (` [(~ location_code) - (#.Record (~ meta))]))] - (case type' - (#Some type'') - (let [typeC (` (#.Named [(~ (text$ module_name)) - (~ (text$ name))] - (.type (~ type''))))] - (in_meta (list (case tags?? - (#Some tags) - (` ("lux def type tagged" (~ type_name) - (~ typeC) - (~ total_meta) - [(~+ (list\map text$ tags))] - (~ export_policy))) - - _ - (` ("lux def" (~ type_name) - ("lux type check type" - (~ typeC)) - (~ total_meta) - (~ export_policy))))))) + _ + (#Some (` (.All (~ type_name) [(~+ (list\each local_identifier$ args))] (~ type))))))) + total_meta (let [meta (definition_annotations meta) + meta (if rec? + (` (#.Item (~ (flag_meta "type_rec?")) (~ meta))) + meta)] + (` [(~ location_code) + (#.Record (~ meta))]))]] + (case type' + (#Some type'') + (let [typeC (` (#.Named [(~ (text$ module_name)) + (~ (text$ name))] + (.type (~ type''))))] + (in_meta (list (case tags?? + (#Some tags) + (` ("lux def type tagged" (~ type_name) + (~ typeC) + (~ total_meta) + [(~+ (list\each text$ tags))] + (~ export_policy))) + + _ + (` ("lux def" (~ type_name) + ("lux type check type" + (~ typeC)) + (~ total_meta) + (~ export_policy))))))) - #None - (failure "Wrong syntax for type:")))) + #None + (failure "Wrong syntax for type:"))) #None (failure "Wrong syntax for type:"))) @@ -3843,32 +3909,34 @@ (case (interfaceP tokens) (#Some [export_policy name args annotations methods]) (do meta_monad - [methods' (monad\map meta_monad expansion methods) + [methods' (monad\each meta_monad expansion methods) members (: (Meta (List [Text Code])) - (monad\map meta_monad - (: (-> Code (Meta [Text Code])) - (function (_ token) - (case token - (^ [_ (#Form (list [_ (#Text "lux type check")] type [_ (#Identifier ["" name])]))]) - (in [name type]) - - _ - (failure "Interfaces require typed members!")))) - (list\joined methods'))) + (monad\each meta_monad + (: (-> Code (Meta [Text Code])) + (function (_ token) + (case token + (^ [_ (#Form (list [_ (#Text "lux type check")] type [_ (#Identifier ["" name])]))]) + (in [name type]) + + _ + (failure "Interfaces require typed members!")))) + (list\conjoint methods'))) .let [def_name (local_identifier$ name) - interface_type (record$ (list\map (: (-> [Text Code] [Code Code]) - (function (_ [module_name m_type]) - [(local_tag$ module_name) m_type])) - members)) - interface_annotations (merged_definition_annotations (` {#.interface? #1}) - (record$ annotations)) + interface_type (` (..Record + (~ (record$ (list\each (: (-> [Text Code] [Code Code]) + (function (_ [module_name m_type]) + [(local_tag$ module_name) m_type])) + members))))) usage (case args #End def_name _ - (` ((~ def_name) (~+ (list\map local_identifier$ args)))))]] - (in_meta (list (` (..type: (~ export_policy) (~ usage) (~ interface_annotations) (~ interface_type)))))) + (` ((~ def_name) (~+ (list\each local_identifier$ args)))))]] + (in_meta (list (` (..type: (~ export_policy) + (~ usage) + (~ (record$ annotations)) + (~ interface_type)))))) #None (failure "Wrong syntax for interface:"))) @@ -3886,36 +3954,39 @@ ) (type: Referrals - #All - (#Only (List Text)) - (#Exclude (List Text)) - #Ignore - #Nothing) + (Variant + #All + (#Only (List Text)) + (#Exclude (List Text)) + #Ignore + #Nothing)) (type: Openings [Text (List Text)]) (type: Refer - {#refer_defs Referrals - #refer_open (List Openings)}) + (Record + {#refer_defs Referrals + #refer_open (List Openings)})) (type: Importation - {#import_name Text - #import_alias (Maybe Text) - #import_refer Refer}) + (Record + {#import_name Text + #import_alias (Maybe Text) + #import_refer Refer})) (def: (referral_references defs) (-> (List Code) (Meta (List Text))) - (monad\map meta_monad - (: (-> Code (Meta Text)) - (function (_ def) - (case def - [_ (#Identifier ["" name])] - (in_meta name) + (monad\each meta_monad + (: (-> Code (Meta Text)) + (function (_ def) + (case def + [_ (#Identifier ["" name])] + (in_meta name) - _ - (failure "#only/#+ and #exclude/#- require identifiers.")))) - defs)) + _ + (failure "#only/#+ and #exclude/#- require identifiers.")))) + defs)) (def: (referrals_parser tokens) (-> (List Code) (Meta [Referrals (List Code)])) @@ -3946,27 +4017,27 @@ (def: (openings_parser parts) (-> (List Code) (Meta [(List Openings) (List Code)])) (case parts - #.End - (in_meta [#.End #.End]) + #End + (in_meta [#End #End]) (^ (list& [_ (#Form (list& [_ (#Text prefix)] structs))] parts')) (do meta_monad - [structs' (monad\map meta_monad - (function (_ struct) - (case struct - [_ (#Identifier ["" struct_name])] - (in_meta struct_name) - - _ - (failure "Expected all implementations of opening form to be identifiers."))) - structs) + [structs' (monad\each meta_monad + (function (_ struct) + (case struct + [_ (#Identifier ["" struct_name])] + (in_meta struct_name) + + _ + (failure "Expected all implementations of opening form to be identifiers."))) + structs) next+remainder (openings_parser parts')] (let [[next remainder] next+remainder] - (in_meta [(#.Item [prefix structs'] next) + (in_meta [(#Item [prefix structs'] next) remainder]))) _ - (in_meta [#.End parts]))) + (in_meta [#End parts]))) (def: (text\split_at' at x) (-> Nat Text [Text Text]) @@ -3986,10 +4057,10 @@ ((: (-> Text Text Text) (function (recur left right) (case (..text\split_by pattern right) - (#.Some [pre post]) + (#Some [pre post]) (recur ($_ "lux text concat" left pre replacement) post) - #.None + #None ("lux text concat" left right)))) "" template)) @@ -4013,23 +4084,23 @@ (-> Text Text Text) (case [(text\split_by ..module_separator hierarchy) (text\split_by ..parallel_hierarchy_sigil root)] - [(#.Some [_ hierarchy']) - (#.Some ["" root'])] + [(#Some [_ hierarchy']) + (#Some ["" root'])] (normal_parallel_path' hierarchy' root') _ (case root "" hierarchy - _ ($_ text\compose root ..module_separator hierarchy)))) + _ ($_ text\composite root ..module_separator hierarchy)))) (def: (normal_parallel_path hierarchy root) (-> Text Text (Maybe Text)) (case (text\split_by ..parallel_hierarchy_sigil root) - (#.Some ["" root']) - (#.Some (normal_parallel_path' hierarchy root')) + (#Some ["" root']) + (#Some (normal_parallel_path' hierarchy root')) _ - #.None)) + #None)) (def: (relative_ups relatives input) (-> Nat Text Nat) @@ -4071,7 +4142,7 @@ clean ("lux text clip" relatives (|> module "lux text size" ("lux i64 -" relatives)) module) output (case ("lux text size" clean) 0 prefix - _ ($_ text\compose prefix ..module_separator clean))] + _ ($_ text\composite prefix ..module_separator clean))] (in_meta output)) (failure ($_ "lux text concat" "Cannot climb the module hierarchy..." ..\n @@ -4081,78 +4152,78 @@ (def: (imports_parser nested? relative_root context_alias imports) (-> Bit Text Text (List Code) (Meta (List Importation))) (do meta_monad - [imports' (monad\map meta_monad - (: (-> Code (Meta (List Importation))) - (function (_ token) - (case token - ... Simple - [_ (#Identifier ["" module_name])] - (do meta_monad - [absolute_module_name (..absolute_module_name nested? relative_root module_name)] - (in (list {#import_name absolute_module_name - #import_alias #None - #import_refer {#refer_defs #All - #refer_open (list)}}))) - - ... Nested - (^ [_ (#Tuple (list& [_ (#Identifier ["" module_name])] extra))]) - (do meta_monad - [absolute_module_name (case (normal_parallel_path relative_root module_name) - (#.Some parallel_path) - (in parallel_path) - - #.None - (..absolute_module_name nested? relative_root module_name)) - referral+extra (referrals_parser extra) - .let [[referral extra] referral+extra] - openings+extra (openings_parser extra) - .let [[openings extra] openings+extra] - sub_imports (imports_parser #1 absolute_module_name context_alias extra)] - (in (case [referral openings] - [#Nothing #End] - sub_imports - - _ - (list& {#import_name absolute_module_name - #import_alias #None - #import_refer {#refer_defs referral - #refer_open openings}} - sub_imports)))) - - (^ [_ (#Tuple (list& [_ (#Text alias)] [_ (#Identifier ["" module_name])] extra))]) - (do meta_monad - [absolute_module_name (case (normal_parallel_path relative_root module_name) - (#.Some parallel_path) - (in parallel_path) - - #.None - (..absolute_module_name nested? relative_root module_name)) - referral+extra (referrals_parser extra) - .let [[referral extra] referral+extra] - openings+extra (openings_parser extra) - .let [[openings extra] openings+extra - module_alias (..module_alias context_alias module_name alias)] - sub_imports (imports_parser #1 absolute_module_name module_alias extra)] - (in (case [referral openings] - [#Ignore #End] - sub_imports - - _ - (list& {#import_name absolute_module_name - #import_alias (#Some module_alias) - #import_refer {#refer_defs referral - #refer_open openings}} - sub_imports)))) - - ... Unrecognized syntax. - _ - (do meta_monad - [current_module current_module_name] - (failure ($_ text\compose - "Wrong syntax for import @ " current_module - ..\n (code\encoded token))))))) - imports)] - (in (list\joined imports')))) + [imports' (monad\each meta_monad + (: (-> Code (Meta (List Importation))) + (function (_ token) + (case token + ... Simple + [_ (#Identifier ["" module_name])] + (do meta_monad + [absolute_module_name (..absolute_module_name nested? relative_root module_name)] + (in (list {#import_name absolute_module_name + #import_alias #None + #import_refer {#refer_defs #All + #refer_open (list)}}))) + + ... Nested + (^ [_ (#Tuple (list& [_ (#Identifier ["" module_name])] extra))]) + (do meta_monad + [absolute_module_name (case (normal_parallel_path relative_root module_name) + (#Some parallel_path) + (in parallel_path) + + #None + (..absolute_module_name nested? relative_root module_name)) + referral+extra (referrals_parser extra) + .let [[referral extra] referral+extra] + openings+extra (openings_parser extra) + .let [[openings extra] openings+extra] + sub_imports (imports_parser #1 absolute_module_name context_alias extra)] + (in (case [referral openings] + [#Nothing #End] + sub_imports + + _ + (list& {#import_name absolute_module_name + #import_alias #None + #import_refer {#refer_defs referral + #refer_open openings}} + sub_imports)))) + + (^ [_ (#Tuple (list& [_ (#Text alias)] [_ (#Identifier ["" module_name])] extra))]) + (do meta_monad + [absolute_module_name (case (normal_parallel_path relative_root module_name) + (#Some parallel_path) + (in parallel_path) + + #None + (..absolute_module_name nested? relative_root module_name)) + referral+extra (referrals_parser extra) + .let [[referral extra] referral+extra] + openings+extra (openings_parser extra) + .let [[openings extra] openings+extra + module_alias (..module_alias context_alias module_name alias)] + sub_imports (imports_parser #1 absolute_module_name module_alias extra)] + (in (case [referral openings] + [#Ignore #End] + sub_imports + + _ + (list& {#import_name absolute_module_name + #import_alias (#Some module_alias) + #import_refer {#refer_defs referral + #refer_open openings}} + sub_imports)))) + + ... Unrecognized syntax. + _ + (do meta_monad + [current_module current_module_name] + (failure ($_ text\composite + "Wrong syntax for import @ " current_module + ..\n (code\encoded token))))))) + imports)] + (in (list\conjoint imports')))) (def: (exported_definitions module state) (-> Text (Meta (List Text))) @@ -4164,23 +4235,23 @@ [current_module modules])] (case (plist\value module modules) (#Some =module) - (let [to_alias (list\map (: (-> [Text Global] - (List Text)) - (function (_ [name definition]) - (case definition - (#Left _) - (list) - - (#Right [exported? def_type def_meta def_value]) - (if exported? - (list name) - (list))))) - (let [{#module_hash _ #module_aliases _ #definitions definitions #imports _ #tags tags #types types #module_annotations _ #module_state _} =module] - definitions))] - (#Right state (list\joined to_alias))) + (let [to_alias (list\each (: (-> [Text Global] + (List Text)) + (function (_ [name definition]) + (case definition + (#Left _) + (list) + + (#Right [exported? def_type def_meta def_value]) + (if exported? + (list name) + (list))))) + (let [{#module_hash _ #module_aliases _ #definitions definitions #imports _ #tags tags #types types #module_annotations _ #module_state _} =module] + definitions))] + (#Right state (list\conjoint to_alias))) #None - (#Left ($_ text\compose + (#Left ($_ text\composite "Unknown module: " (text\encoded module) ..\n "Current module: " (case current_module (#Some current_module) @@ -4189,8 +4260,8 @@ #None "???") ..\n "Known modules: " (|> modules - (list\map (function (_ [name module]) - (text$ name))) + (list\each (function (_ [name module]) + (text$ name))) tuple$ code\encoded)))) )) @@ -4278,12 +4349,12 @@ #scope_type_vars scope_type_vars #eval _eval} state] (case (plist\value v_module modules) #None - (#Left (text\compose "Unknown definition: " (name\encoded name))) + (#Left (text\composite "Unknown definition: " (name\encoded name))) (#Some {#definitions definitions #module_hash _ #module_aliases _ #imports _ #tags tags #types types #module_annotations _ #module_state _}) (case (plist\value v_name definitions) #None - (#Left (text\compose "Unknown definition: " (name\encoded name))) + (#Left (text\composite "Unknown definition: " (name\encoded name))) (#Some definition) (case definition @@ -4321,13 +4392,13 @@ (#Right [compiler struct_type]) _ - (#Left ($_ text\compose "Unknown var: " (name\encoded full_name))))) + (#Left ($_ text\composite "Unknown var: " (name\encoded full_name))))) (case (definition_type full_name compiler) (#Some struct_type) (#Right [compiler struct_type]) _ - (#Left ($_ text\compose "Unknown var: " (name\encoded full_name)))))] + (#Left ($_ text\composite "Unknown var: " (name\encoded full_name)))))] (case temp (#Right [compiler (#Var type_id)]) (let [{#info _ #source _ #current_module _ #modules _ @@ -4369,37 +4440,37 @@ name _ - ($_ text\compose "(" name " " (|> params (list\map type\encoded) (list\interposed " ") list\reversed (list\mix text\compose "")) ")")) + ($_ text\composite "(" name " " (|> params (list\each type\encoded) (list\interposed " ") list\reversed (list\mix text\composite "")) ")")) (#Sum _) - ($_ text\compose "(Or " (|> (flat_variant type) (list\map type\encoded) (list\interposed " ") list\reversed (list\mix text\compose "")) ")") + ($_ text\composite "(Or " (|> (flat_variant type) (list\each type\encoded) (list\interposed " ") list\reversed (list\mix text\composite "")) ")") (#Product _) - ($_ text\compose "[" (|> (flat_tuple type) (list\map type\encoded) (list\interposed " ") list\reversed (list\mix text\compose "")) "]") + ($_ text\composite "[" (|> (flat_tuple type) (list\each type\encoded) (list\interposed " ") list\reversed (list\mix text\composite "")) "]") (#Function _) - ($_ text\compose "(-> " (|> (flat_lambda type) (list\map type\encoded) (list\interposed " ") list\reversed (list\mix text\compose "")) ")") + ($_ text\composite "(-> " (|> (flat_lambda type) (list\each type\encoded) (list\interposed " ") list\reversed (list\mix text\composite "")) ")") (#Parameter id) (nat\encoded id) (#Var id) - ($_ text\compose "⌈v:" (nat\encoded id) "⌋") + ($_ text\composite "⌈v:" (nat\encoded id) "⌋") (#Ex id) - ($_ text\compose "⟨e:" (nat\encoded id) "⟩") + ($_ text\composite "⟨e:" (nat\encoded id) "⟩") (#UnivQ env body) - ($_ text\compose "(All " (type\encoded body) ")") + ($_ text\composite "(All " (type\encoded body) ")") (#ExQ env body) - ($_ text\compose "(Ex " (type\encoded body) ")") + ($_ text\composite "(Ex " (type\encoded body) ")") (#Apply _) (let [[func args] (flat_application type)] - ($_ text\compose + ($_ text\composite "(" (type\encoded func) " " - (|> args (list\map type\encoded) (list\interposed " ") list\reversed (list\mix text\compose "")) + (|> args (list\each type\encoded) (list\interposed " ") list\reversed (list\mix text\composite "")) ")")) (#Named name _) @@ -4425,16 +4496,16 @@ struct_evidence (record_slots init_type)] (case struct_evidence #None - (failure (text\compose "Can only 'open' structs: " (type\encoded init_type))) + (failure (text\composite "Can only 'open' structs: " (type\encoded init_type))) (#Some tags&members) (do meta_monad [full_body ((: (-> Name [(List Name) (List Type)] Code (Meta Code)) (function (recur source [tags members] target) - (let [locals (list\map (function (_ [t_module t_name]) - ["" (..module_alias "" t_name alias)]) - tags) - pattern (tuple$ (list\map identifier$ locals))] + (let [locals (list\each (function (_ [t_module t_name]) + ["" (..module_alias "" t_name alias)]) + tags) + pattern (tuple$ (list\each identifier$ locals))] (do meta_monad [enhanced_target (monad\mix meta_monad (function (_ [m_local m_type] enhanced_target) @@ -4513,13 +4584,13 @@ g!output (..identifier "")] (case (interface_methods type) (#Some members) - (let [pattern (record$ (list\map (: (-> [Name [Nat Type]] [Code Code]) - (function (_ [[r_module r_name] [r_idx r_type]]) - [(tag$ [r_module r_name]) - (if ("lux i64 =" idx r_idx) - g!output - g!_)])) - (zipped/2 tags (enumeration members))))] + (let [pattern (record$ (list\each (: (-> [Name [Nat Type]] [Code Code]) + (function (_ [[r_module r_name] [r_idx r_type]]) + [(tag$ [r_module r_name]) + (if ("lux i64 =" idx r_idx) + g!output + g!_)])) + (zipped/2 tags (enumeration members))))] (in_meta (list (` ({(~ pattern) (~ g!output)} (~ record)))))) _ @@ -4549,26 +4620,26 @@ .let [g!output (local_identifier$ short) pattern (|> tags enumeration - (list\map (function (_ [tag_idx tag]) - (if ("lux i64 =" my_tag_index tag_idx) - g!output - g!_))) + (list\each (function (_ [tag_idx tag]) + (if ("lux i64 =" my_tag_index tag_idx) + g!output + g!_))) tuple$) source+ (` ({(~ pattern) (~ g!output)} (~ source)))]] (case output (#Some [tags' members']) (do meta_monad - [decls' (monad\map meta_monad - (: (-> [Nat Name Type] (Meta (List Code))) - (function (_ [sub_tag_index sname stype]) - (open_declaration alias tags' sub_tag_index sname source+ stype))) - (enumeration (zipped/2 tags' members')))] - (in_meta (list\joined decls'))) + [decls' (monad\each meta_monad + (: (-> [Nat Name Type] (Meta (List Code))) + (function (_ [sub_tag_index sname stype]) + (open_declaration alias tags' sub_tag_index sname source+ stype))) + (enumeration (zipped/2 tags' members')))] + (in_meta (list\conjoint decls'))) _ (in_meta (list (` ("lux def" (~ (local_identifier$ (..module_alias "" short alias))) (~ source+) - [(~ location_code) (#.Record #End)] + [(~ location_code) (#.Record #.End)] #0))))))) (macro: .public (open: tokens) @@ -4594,20 +4665,20 @@ (case output (#Some [tags members]) (do meta_monad - [decls' (monad\map meta_monad (: (-> [Nat Name Type] (Meta (List Code))) - (function (_ [tag_index sname stype]) - (open_declaration alias tags tag_index sname source stype))) - (enumeration (zipped/2 tags members)))] - (in_meta (list\joined decls'))) + [decls' (monad\each meta_monad (: (-> [Nat Name Type] (Meta (List Code))) + (function (_ [tag_index sname stype]) + (open_declaration alias tags tag_index sname source stype))) + (enumeration (zipped/2 tags members)))] + (in_meta (list\conjoint decls'))) _ - (failure (text\compose "Can only 'open:' structs: " (type\encoded struct_type))))) + (failure (text\composite "Can only 'open:' structs: " (type\encoded struct_type))))) _ (do meta_monad [g!struct (..identifier "struct")] (in_meta (list (` ("lux def" (~ g!struct) (~ struct) - [(~ location_code) (#.Record #End)] + [(~ location_code) (#.Record #.End)] #0)) (` (..open: (~ (text$ alias)) (~ g!struct))))))) @@ -4617,9 +4688,9 @@ (macro: .public (|>> tokens) {#.doc (text$ ($_ "lux text concat" "... Similar to the piping macro, but rather than taking an initial object to work on, creates a function for taking it." ..\n - "(|>> (list\map int\encoded) (interposed '' '') (mix text\compose ''''))" ..\n + "(|>> (list\each int\encoded) (interposed '' '') (mix text\composite ''''))" ..\n "... =>" ..\n - "(function (_ <arg>) (mix text\compose '''' (interposed '' '' (list\map int\encoded <arg>))))"))} + "(function (_ <arg>) (mix text\composite '''' (interposed '' '' (list\each int\encoded <arg>))))"))} (do meta_monad [g!_ (..identifier "_") g!arg (..identifier "arg")] @@ -4628,9 +4699,9 @@ (macro: .public (<<| tokens) {#.doc (text$ ($_ "lux text concat" "... Similar to the piping macro, but rather than taking an initial object to work on, creates a function for taking it." ..\n - "(<<| (mix text\compose '''') (interposed '' '') (list\map int\encoded))" ..\n + "(<<| (mix text\composite '''') (interposed '' '') (list\each int\encoded))" ..\n "... =>" ..\n - "(function (_ <arg>) (mix text\compose '''' (interposed '' '' (list\map int\encoded <arg>))))"))} + "(function (_ <arg>) (mix text\composite '''' (interposed '' '' (list\each int\encoded <arg>))))"))} (do meta_monad [g!_ (..identifier "_") g!arg (..identifier "arg")] @@ -4657,11 +4728,11 @@ #refer_open openings}) _ - (failure ($_ text\compose "Wrong syntax for refer @ " current_module + (failure ($_ text\composite "Wrong syntax for refer @ " current_module ..\n (|> options - (list\map code\encoded) + (list\each code\encoded) (list\interposed " ") - (list\mix text\compose ""))))))) + (list\mix text\composite ""))))))) (def: (referral_definitions module_name [r_defs r_opens]) (-> Text Refer (Meta (List Code))) @@ -4669,13 +4740,13 @@ [current_module current_module_name .let [test_referrals (: (-> Text (List Text) (List Text) (Meta (List Any))) (function (_ module_name all_defs referred_defs) - (monad\map meta_monad - (: (-> Text (Meta Any)) - (function (_ _def) - (if (is_member? all_defs _def) - (in_meta []) - (failure ($_ text\compose _def " is not defined in module " module_name " @ " current_module))))) - referred_defs)))] + (monad\each meta_monad + (: (-> Text (Meta Any)) + (function (_ _def) + (if (is_member? all_defs _def) + (in_meta []) + (failure ($_ text\composite _def " is not defined in module " module_name " @ " current_module))))) + referred_defs)))] defs' (case r_defs #All (exported_definitions module_name) @@ -4697,18 +4768,18 @@ #Nothing (in (list))) - .let [defs (list\map (: (-> Text Code) - (function (_ def) - (` ("lux def alias" (~ (local_identifier$ def)) (~ (identifier$ [module_name def])))))) - defs') + .let [defs (list\each (: (-> Text Code) + (function (_ def) + (` ("lux def alias" (~ (local_identifier$ def)) (~ (identifier$ [module_name def])))))) + defs') openings (|> r_opens - (list\map (: (-> Openings (List Code)) - (function (_ [alias structs]) - (list\map (function (_ name) - (` (open: (~ (text$ alias)) (~ (identifier$ [module_name name]))))) - structs)))) - list\joined)]] - (in (list\compose defs openings)))) + (list\each (: (-> Openings (List Code)) + (function (_ [alias structs]) + (list\each (function (_ name) + (` (open: (~ (text$ alias)) (~ (identifier$ [module_name name]))))) + structs)))) + list\conjoint)]] + (in (list\composite defs openings)))) (macro: (refer tokens) (case tokens @@ -4729,20 +4800,20 @@ (list (' #*)) (#Only defs) - (list (form$ (list& (' #+) (list\map local_identifier$ defs)))) + (list (form$ (list& (' #+) (list\each local_identifier$ defs)))) (#Exclude defs) - (list (form$ (list& (' #-) (list\map local_identifier$ defs)))) + (list (form$ (list& (' #-) (list\each local_identifier$ defs)))) #Ignore (list) #Nothing (list))) - openings (list\map (function (_ [alias structs]) - (form$ (list& (text$ (..replaced ..contextual_reference module_alias alias)) - (list\map local_identifier$ structs)))) - r_opens)] + openings (list\each (function (_ [alias structs]) + (form$ (list& (text$ (..replaced ..contextual_reference module_alias alias)) + (list\each local_identifier$ structs)))) + r_opens)] (` ((~! ..refer) (~ (text$ module_name)) (~+ localizations) (~+ openings))))) @@ -4776,14 +4847,14 @@ current_module current_module_name imports (imports_parser #0 current_module "" _imports) .let [=imports (|> imports - (list\map (: (-> Importation Code) - (function (_ [module_name m_alias =refer]) - (` [(~ (text$ module_name)) (~ (text$ (..else "" m_alias)))])))) + (list\each (: (-> Importation Code) + (function (_ [module_name m_alias =refer]) + (` [(~ (text$ module_name)) (~ (text$ (..else "" m_alias)))])))) tuple$) - =refers (list\map (: (-> Importation Code) - (function (_ [module_name m_alias =refer]) - (refer_code module_name m_alias =refer))) - imports) + =refers (list\each (: (-> Importation Code) + (function (_ [module_name m_alias =refer]) + (refer_code module_name m_alias =refer))) + imports) =module (` ("lux def module" [(~ location_code) (#.Record (~ (definition_annotations _meta)))] (~ =imports)))]] @@ -4826,25 +4897,25 @@ (case (interface_methods type) (#Some members) (do meta_monad - [pattern' (monad\map meta_monad - (: (-> [Name [Nat Type]] (Meta [Name Nat Code])) - (function (_ [r_slot_name [r_idx r_type]]) - (do meta_monad - [g!slot (..identifier "")] - (in_meta [r_slot_name r_idx g!slot])))) - (zipped/2 tags (enumeration members)))] - (let [pattern (record$ (list\map (: (-> [Name Nat Code] [Code Code]) + [pattern' (monad\each meta_monad + (: (-> [Name [Nat Type]] (Meta [Name Nat Code])) + (function (_ [r_slot_name [r_idx r_type]]) + (do meta_monad + [g!slot (..identifier "")] + (in_meta [r_slot_name r_idx g!slot])))) + (zipped/2 tags (enumeration members)))] + (let [pattern (record$ (list\each (: (-> [Name Nat Code] [Code Code]) + (function (_ [r_slot_name r_idx r_var]) + [(tag$ r_slot_name) + r_var])) + pattern')) + output (record$ (list\each (: (-> [Name Nat Code] [Code Code]) (function (_ [r_slot_name r_idx r_var]) [(tag$ r_slot_name) - r_var])) - pattern')) - output (record$ (list\map (: (-> [Name Nat Code] [Code Code]) - (function (_ [r_slot_name r_idx r_var]) - [(tag$ r_slot_name) - (if ("lux i64 =" idx r_idx) - value - r_var)])) - pattern'))] + (if ("lux i64 =" idx r_idx) + value + r_var)])) + pattern'))] (in_meta (list (` ({(~ pattern) (~ output)} (~ record))))))) _ @@ -4857,10 +4928,10 @@ _ (do meta_monad - [bindings (monad\map meta_monad - (: (-> Code (Meta Code)) - (function (_ _) (..identifier "temp"))) - slots) + [bindings (monad\each meta_monad + (: (-> Code (Meta Code)) + (function (_ _) (..identifier "temp"))) + slots) .let [pairs (zipped/2 slots bindings) update_expr (list\mix (: (-> [Code Code] Code Code) (function (_ [s b] v) @@ -4873,7 +4944,7 @@ (#Item (list new_binding old_record) accesses')])) [record (: (List (List Code)) #End)] pairs) - accesses (list\joined (list\reversed accesses'))]] + accesses (list\conjoint (list\reversed accesses'))]] (in (list (` (let [(~+ accesses)] (~ update_expr))))))) @@ -4915,25 +4986,25 @@ (case (interface_methods type) (#Some members) (do meta_monad - [pattern' (monad\map meta_monad - (: (-> [Name [Nat Type]] (Meta [Name Nat Code])) - (function (_ [r_slot_name [r_idx r_type]]) - (do meta_monad - [g!slot (..identifier "")] - (in_meta [r_slot_name r_idx g!slot])))) - (zipped/2 tags (enumeration members)))] - (let [pattern (record$ (list\map (: (-> [Name Nat Code] [Code Code]) + [pattern' (monad\each meta_monad + (: (-> [Name [Nat Type]] (Meta [Name Nat Code])) + (function (_ [r_slot_name [r_idx r_type]]) + (do meta_monad + [g!slot (..identifier "")] + (in_meta [r_slot_name r_idx g!slot])))) + (zipped/2 tags (enumeration members)))] + (let [pattern (record$ (list\each (: (-> [Name Nat Code] [Code Code]) + (function (_ [r_slot_name r_idx r_var]) + [(tag$ r_slot_name) + r_var])) + pattern')) + output (record$ (list\each (: (-> [Name Nat Code] [Code Code]) (function (_ [r_slot_name r_idx r_var]) [(tag$ r_slot_name) - r_var])) - pattern')) - output (record$ (list\map (: (-> [Name Nat Code] [Code Code]) - (function (_ [r_slot_name r_idx r_var]) - [(tag$ r_slot_name) - (if ("lux i64 =" idx r_idx) - (` ((~ fun) (~ r_var))) - r_var)])) - pattern'))] + (if ("lux i64 =" idx r_idx) + (` ((~ fun) (~ r_var))) + r_var)])) + pattern'))] (in_meta (list (` ({(~ pattern) (~ output)} (~ record))))))) _ @@ -4977,7 +5048,7 @@ " (-> (List Type) Type Type)" ..\n " (case type" ..\n " (#.Primitive name params)" ..\n - " (#.Primitive name (list\map (reduced env) params))" + " (#.Primitive name (list\each (reduced env) params))" __paragraph " (^template [<tag>]" ..\n " [(<tag> left right)" ..\n @@ -5012,20 +5083,20 @@ branches)) (case (: (Maybe (List Code)) (do maybe_monad - [bindings' (monad\map maybe_monad identifier_short bindings) - data' (monad\map maybe_monad tuple_list data)] + [bindings' (monad\each maybe_monad identifier_short bindings) + data' (monad\each maybe_monad tuple_list data)] (let [num_bindings (list\size bindings')] (if (every? (|>> ("lux i64 =" num_bindings)) - (list\map list\size data')) + (list\each list\size data')) (let [apply (: (-> Replacement_Environment (List Code)) - (function (_ env) (list\map (realized_template env) templates)))] + (function (_ env) (list\each (realized_template env) templates)))] (|> data' - (list\map (function\composite apply (replacement_environment bindings'))) - list\joined + (list\each (function\composite apply (replacement_environment bindings'))) + list\conjoint in)) #None)))) (#Some output) - (in_meta (list\compose output branches)) + (in_meta (list\composite output branches)) #None (failure "Wrong syntax for ^template")) @@ -5050,19 +5121,20 @@ (^template [<tag>] [[[_ _ column] (<tag> parts)] - (list\mix n/min column (list\map baseline_column parts))]) + (list\mix n/min column (list\each baseline_column parts))]) ([#Form] [#Tuple]) [[_ _ column] (#Record pairs)] (list\mix n/min column - (list\compose (list\map (|>> product\left baseline_column) pairs) - (list\map (|>> product\right baseline_column) pairs))) + (list\composite (list\each (|>> product\left baseline_column) pairs) + (list\each (|>> product\right baseline_column) pairs))) )) (type: Documentation_Fragment - (#Documentation_Comment Text) - (#Documentation_Example Code)) + (Variant + (#Documentation_Comment Text) + (#Documentation_Example Code))) (def: (documentation_fragment code) (-> Code Documentation_Fragment) @@ -5085,7 +5157,8 @@ (def: tag\encoded (-> Name Text) - (|>> name\encoded (text\compose "#"))) + (|>> name\encoded + (text\composite "#"))) (def: (repeated n x) (All [a] (-> Int a (List a))) @@ -5099,7 +5172,7 @@ (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)))) + (text\composite extra_lines space_padding)))) (def: (text\size x) (-> Text Nat) @@ -5109,14 +5182,6 @@ (-> Location Text Location) [file line ("lux i64 +" column (text\size code_text))]) -(def: un_paired - (-> (List [Code Code]) (List Code)) - (let [pair_list (: (-> [Code Code] (List Code)) - (function (_ [left right]) - (list left right)))] - (|>> (list\map pair_list) - list\joined))) - (def: (example_documentation prev_location baseline example) (-> Location Nat Code [Location Text]) (case example @@ -5124,8 +5189,8 @@ [[new_location (<tag> value)] (let [as_text (<encoded> value)] [(updated_location new_location as_text) - (text\compose (location_padding baseline prev_location new_location) - as_text)])]) + (text\composite (location_padding baseline prev_location new_location) + as_text)])]) ([#Bit bit\encoded] [#Nat nat\encoded] [#Int int\encoded] @@ -5138,11 +5203,11 @@ [[group_location (<tag> parts)] (let [[group_location' parts_text] (list\mix (function (_ part [last_location text_accum]) (let [[part_location part_text] (example_documentation last_location baseline part)] - [part_location (text\compose text_accum part_text)])) + [part_location (text\composite text_accum part_text)])) [(revised@ #column ++ group_location) ""] (<prep> parts))] [(revised@ #column ++ group_location') - ($_ text\compose (location_padding baseline prev_location group_location) + ($_ text\composite (location_padding baseline prev_location group_location) <open> parts_text <close>)])]) @@ -5160,14 +5225,14 @@ (#Documentation_Comment comment) (|> comment (text\all_split_by ..\n) - (list\map (function (_ line) ($_ text\compose "... " line ..\n))) + (list\each (function (_ line) ($_ text\composite "... " line ..\n))) (text\interposed "")) (#Documentation_Example example) (let [baseline (baseline_column example) [location _] example - [_ text] (..example_documentation (with@ #.column baseline location) baseline example)] - (text\compose text __paragraph)))) + [_ text] (..example_documentation (with@ #column baseline location) baseline example)] + (text\composite text __paragraph)))) (macro: .public (example tokens) {#.doc (text$ ($_ "lux text concat" @@ -5183,7 +5248,7 @@ " x)))"))} (in_meta (list (` [(~ location_code) (#.Text (~ (|> tokens - (list\map (|>> ..documentation_fragment ..fragment_documentation)) + (list\each (|>> ..documentation_fragment ..fragment_documentation)) (text\interposed "") text$)))])))) @@ -5205,7 +5270,7 @@ (-> Type Code) (case type (#Primitive name params) - (` (#.Primitive (~ (text$ name)) (~ (untemplated_list (list\map type_code params))))) + (` (#.Primitive (~ (text$ name)) (~ (untemplated_list (list\each type_code params))))) (^template [<tag>] [(<tag> left right) @@ -5221,7 +5286,7 @@ (^template [<tag>] [(<tag> env type) - (let [env' (untemplated_list (list\map type_code env))] + (let [env' (untemplated_list (list\each type_code env))] (` (<tag> (~ env') (~ (type_code type)))))]) ([#.UnivQ] [#.ExQ]) @@ -5250,43 +5315,43 @@ x)))} (let [?params (case tokens (^ (list name [_ (#Tuple bindings)] body)) - (#.Some [name bindings body]) + (#Some [name bindings body]) (^ (list [_ (#Tuple bindings)] body)) - (#.Some [(local_identifier$ "recur") bindings body]) + (#Some [(local_identifier$ "recur") bindings body]) _ - #.None)] + #None)] (case ?params - (#.Some [name bindings body]) + (#Some [name bindings body]) (let [pairs (pairs bindings) - vars (list\map product\left pairs) - inits (list\map product\right pairs)] + vars (list\each product\left pairs) + inits (list\each product\right pairs)] (if (every? identifier? inits) (do meta_monad [inits' (: (Meta (List Name)) - (case (monad\map maybe_monad identifier_name inits) + (case (monad\each maybe_monad identifier_name inits) (#Some inits') (in_meta inits') #None (failure "Wrong syntax for loop"))) - init_types (monad\map meta_monad type_definition inits') + init_types (monad\each meta_monad type_definition inits') expected ..expected_type] (in_meta (list (` (("lux type check" - (-> (~+ (list\map type_code init_types)) + (-> (~+ (list\each type_code init_types)) (~ (type_code expected))) (function ((~ name) (~+ vars)) (~ body))) (~+ inits)))))) (do meta_monad - [aliases (monad\map meta_monad - (: (-> Code (Meta Code)) - (function (_ _) (..identifier ""))) - inits)] + [aliases (monad\each meta_monad + (: (-> Code (Meta Code)) + (function (_ _) (..identifier ""))) + inits)] (in_meta (list (` (let [(~+ (..interleaved aliases inits))] (.loop (~ name) [(~+ (..interleaved vars aliases))] (~ body))))))))) - #.None + #None (failure "Wrong syntax for loop")))) (macro: .public (^slots tokens) @@ -5301,7 +5366,7 @@ (case (: (Maybe [Name (List Name)]) (do maybe_monad [hslot (..tag_name hslot') - tslots (monad\map maybe_monad ..tag_name tslots')] + tslots (monad\each maybe_monad ..tag_name tslots')] (in [hslot tslots]))) (#Some slots) (in_meta slots) @@ -5310,21 +5375,21 @@ (failure "Wrong syntax for ^slots"))) .let [[hslot tslots] slots] hslot (..normal hslot) - tslots (monad\map meta_monad ..normal tslots) + tslots (monad\each meta_monad ..normal tslots) output (..type_tag hslot) g!_ (..identifier "_") .let [[idx tags exported? type] output - slot_pairings (list\map (: (-> Name [Text Code]) - (function (_ [module name]) - [name (local_identifier$ name)])) - (list& hslot tslots)) - pattern (record$ (list\map (: (-> Name [Code Code]) - (function (_ [module name]) - (let [tag (tag$ [module name])] - (case (plist\value name slot_pairings) - (#Some binding) [tag binding] - #None [tag g!_])))) - tags))]] + slot_pairings (list\each (: (-> Name [Text Code]) + (function (_ [module name]) + [name (local_identifier$ name)])) + (list& hslot tslots)) + pattern (record$ (list\each (: (-> Name [Code Code]) + (function (_ [module name]) + (let [tag (tag$ [module name])] + (case (plist\value name slot_pairings) + (#Some binding) [tag binding] + #None [tag g!_])))) + tags))]] (in_meta (list& pattern body branches))) _ @@ -5345,26 +5410,26 @@ (^template [<tag>] [[location (<tag> elems)] (do maybe_monad - [placements (monad\map maybe_monad (with_expansions' label tokens) elems)] - (in (list [location (<tag> (list\joined placements))])))]) + [placements (monad\each maybe_monad (with_expansions' label tokens) elems)] + (in (list [location (<tag> (list\conjoint placements))])))]) ([#Tuple] [#Form]) [location (#Record pairs)] (do maybe_monad - [=pairs (monad\map maybe_monad - (: (-> [Code Code] (Maybe [Code Code])) - (function (_ [slot value]) - (do maybe_monad - [slot' (with_expansions' label tokens slot) - value' (with_expansions' label tokens value)] - (case [slot' value'] - (^ [(list =slot) (list =value)]) - (in [=slot =value]) - - _ - #None)))) - pairs)] + [=pairs (monad\each maybe_monad + (: (-> [Code Code] (Maybe [Code Code])) + (function (_ [slot value]) + (do maybe_monad + [slot' (with_expansions' label tokens slot) + value' (with_expansions' label tokens value)] + (case [slot' value'] + (^ [(list =slot) (list =value)]) + (in [=slot =value]) + + _ + #None)))) + pairs)] (in (list [location (#Record =pairs)]))))) (macro: .public (with_expansions tokens) @@ -5448,7 +5513,7 @@ ["Text" Text text$]) _ - (failure (text\compose "Cannot anti-quote type: " (name\encoded name)))))) + (failure (text\composite "Cannot anti-quote type: " (name\encoded name)))))) (def: (static_literal token) (-> Code (Meta Code)) @@ -5463,20 +5528,20 @@ (^template [<tag>] [[meta (<tag> parts)] (do meta_monad - [=parts (monad\map meta_monad static_literal parts)] + [=parts (monad\each meta_monad static_literal parts)] (in [meta (<tag> =parts)]))]) ([#Form] [#Tuple]) [meta (#Record pairs)] (do meta_monad - [=pairs (monad\map meta_monad - (: (-> [Code Code] (Meta [Code Code])) - (function (_ [slot value]) - (do meta_monad - [=value (static_literal value)] - (in [slot =value])))) - pairs)] + [=pairs (monad\each meta_monad + (: (-> [Code Code] (Meta [Code Code])) + (function (_ [slot value]) + (do meta_monad + [=value (static_literal value)] + (in [slot =value])))) + pairs)] (in [meta (#Record =pairs)])) _ @@ -5537,14 +5602,14 @@ (#Item init extras) (do meta_monad - [extras' (monad\map meta_monad case_level^ extras)] + [extras' (monad\each meta_monad case_level^ extras)] (in [init extras'])))) (def: (multi_level_case$ g!_ [[init_pattern levels] body]) (-> Code [Multi_Level_Case Code] (List Code)) (let [inner_pattern_body (list\mix (function (_ [calculation pattern] success) (let [bind? (case pattern - [_ (#.Identifier _)] + [_ (#Identifier _)] #1 _ @@ -5565,28 +5630,28 @@ "Useful in situations where the result of a branch depends on further refinements on the values being matched." "For example:" (case (split (size static) uri) - (^multi (#.Some [chunk uri']) + (^multi (#Some [chunk uri']) {(text\= static chunk) #1}) (match_uri endpoint? parts' uri') _ - (#.Left (format "Static part " (%t static) " does not match URI: " uri))) + (#Left (format "Static part " (%t static) " does not match URI: " uri))) "Short-cuts can be taken when using bit tests." "The example above can be rewritten as..." (case (split (size static) uri) - (^multi (#.Some [chunk uri']) + (^multi (#Some [chunk uri']) (text\= static chunk)) (match_uri endpoint? parts' uri') _ - (#.Left (format "Static part " (%t static) " does not match URI: " uri))))} + (#Left (format "Static part " (%t static) " does not match URI: " uri))))} (case tokens (^ (list& [_meta (#Form levels)] body next_branches)) (do meta_monad [mlc (multi_level_case^ levels) .let [initial_bind? (case mlc - [[_ (#.Identifier _)] _] + [[_ (#Identifier _)] _] #1 _ @@ -5618,7 +5683,7 @@ (def: wrong_syntax_error (-> Name Text) (|>> name\encoded - (text\compose "Wrong syntax for "))) + (text\composite "Wrong syntax for "))) (macro: .public (name_of tokens) {#.doc (example "Given an identifier or a tag, gives back a 2 tuple with the module and name parts, both as Text." @@ -5662,7 +5727,7 @@ (in (list (` (#Ex (~ (nat$ var_id)))))) #None - (failure (text\compose "Indexed-type does not exist: " (nat\encoded idx))))) + (failure (text\composite "Indexed-type does not exist: " (nat\encoded idx))))) _ (failure (..wrong_syntax_error (name_of ..$))))) @@ -5785,36 +5850,36 @@ _ #None)) -(def:' .private (templateP tokens) - (-> (List Code) (Maybe [Code Text (List Text) (List [Code Code]) (List Code)])) - (|> (do maybe_monad - [% (declarationP tokens) - .let' [[tokens [export_policy name parameters]] %] - % (annotationsP tokens) - .let' [[tokens annotations] %] - % (tupleP tokens) - .let' [[tokens templates] %] - _ (endP tokens)] - (in [export_policy name parameters annotations templates])) - ... (^ (list _export_policy _declaration _annotations _body)) - ... (^ (list _declaration _annotations _body)) - (maybe\else' (do maybe_monad - [% (declarationP tokens) - .let' [[tokens [export_policy name parameters]] %] - % (tupleP tokens) - .let' [[tokens templates] %] - _ (endP tokens)] - (in [export_policy name parameters #End templates]))) - ... (^ (list _export_policy _declaration _body)) - (maybe\else' (do maybe_monad - [% (local_declarationP tokens) - .let' [[tokens [name parameters]] %] - % (tupleP tokens) - .let' [[tokens templates] %] - _ (endP tokens)] - (in [(` ..private) name parameters #End templates]))) - ... (^ (list _declaration _body)) - )) +(def: (templateP tokens) + (-> (List Code) (Maybe [Code Text (List Text) (List [Code Code]) (List Code)])) + (|> (do maybe_monad + [% (declarationP tokens) + .let' [[tokens [export_policy name parameters]] %] + % (annotationsP tokens) + .let' [[tokens annotations] %] + % (tupleP tokens) + .let' [[tokens templates] %] + _ (endP tokens)] + (in [export_policy name parameters annotations templates])) + ... (^ (list _export_policy _declaration _annotations _body)) + ... (^ (list _declaration _annotations _body)) + (maybe\else' (do maybe_monad + [% (declarationP tokens) + .let' [[tokens [export_policy name parameters]] %] + % (tupleP tokens) + .let' [[tokens templates] %] + _ (endP tokens)] + (in [export_policy name parameters #End templates]))) + ... (^ (list _export_policy _declaration _body)) + (maybe\else' (do maybe_monad + [% (local_declarationP tokens) + .let' [[tokens [name parameters]] %] + % (tupleP tokens) + .let' [[tokens templates] %] + _ (endP tokens)] + (in [(` ..private) name parameters #End templates]))) + ... (^ (list _declaration _body)) + )) (macro: .public (template: tokens) {#.doc (example "Define macros in the style of template and ^template." @@ -5822,30 +5887,30 @@ (template: (square x) (* x x)))} (case (templateP tokens) - (#.Some [export_policy name args anns input_templates]) + (#Some [export_policy name args anns input_templates]) (do meta_monad [g!tokens (..identifier "tokens") g!compiler (..identifier "compiler") g!_ (..identifier "_") - .let [rep_env (list\map (function (_ arg) - [arg (` ((~' ~) (~ (local_identifier$ arg))))]) - args)] + .let [rep_env (list\each (function (_ arg) + [arg (` ((~' ~) (~ (local_identifier$ arg))))]) + args)] this_module current_module_name] (in (list (` (macro: (~ export_policy) ((~ (local_identifier$ name)) (~ g!tokens) (~ g!compiler)) (~ (record$ anns)) (case (~ g!tokens) - (^ (list (~+ (list\map local_identifier$ args)))) + (^ (list (~+ (list\each local_identifier$ args)))) (#.Right [(~ g!compiler) - (list (~+ (list\map (function (_ template) - (` (`' (~ (with_replacements rep_env - template))))) - input_templates)))]) + (list (~+ (list\each (function (_ template) + (` (`' (~ (with_replacements rep_env + template))))) + input_templates)))]) (~ g!_) (#.Left (~ (text$ (..wrong_syntax_error [this_module name])))))))))) - #.None + #None (failure (..wrong_syntax_error (name_of ..template:))))) (macro: .public (as_is tokens compiler) @@ -5896,12 +5961,12 @@ (in (:as ..Text value)) _ - (failure ($_ text\compose + (failure ($_ text\composite "Invalid target platform (must be a value of type Text): " (name\encoded identifier) " : " (..code\encoded (..type_code type)))))) _ - (failure ($_ text\compose + (failure ($_ text\composite "Invalid target platform syntax: " (..code\encoded choice) ..\n "Must be either a text literal or an identifier.")))) @@ -5910,10 +5975,10 @@ (case options #End (case default - #.None - (failure ($_ text\compose "No code for target platform: " target)) + #None + (failure ($_ text\composite "No code for target platform: " target)) - (#.Some default) + (#Some default) (in_meta (list default))) (#Item [key pick] options') @@ -5934,10 +5999,10 @@ [target ..target] (case tokens (^ (list [_ (#Record options)])) - (target_pick target options #.None) + (target_pick target options #None) (^ (list [_ (#Record options)] default)) - (target_pick target options (#.Some default)) + (target_pick target options (#Some default)) _ (failure (..wrong_syntax_error (name_of ..for)))))) @@ -5961,24 +6026,24 @@ (^template [<tag>] [[ann (<tag> parts)] (do meta_monad - [=parts (monad\map meta_monad embedded_expansions parts)] - (in [(list\mix list\compose (list) (list\map left =parts)) - [ann (<tag> (list\map right =parts))]]))]) + [=parts (monad\each meta_monad embedded_expansions parts)] + (in [(list\mix list\composite (list) (list\each left =parts)) + [ann (<tag> (list\each right =parts))]]))]) ([#Form] [#Tuple]) [ann (#Record kvs)] (do meta_monad - [=kvs (monad\map meta_monad - (function (_ [key val]) - (do meta_monad - [=key (embedded_expansions key) - =val (embedded_expansions val) - .let [[key_labels key_labelled] =key - [val_labels val_labelled] =val]] - (in [(list\compose key_labels val_labels) [key_labelled val_labelled]]))) - kvs)] - (in [(list\mix list\compose (list) (list\map left =kvs)) - [ann (#Record (list\map right =kvs))]])) + [=kvs (monad\each meta_monad + (function (_ [key val]) + (do meta_monad + [=key (embedded_expansions key) + =val (embedded_expansions val) + .let [[key_labels key_labelled] =key + [val_labels val_labelled] =val]] + (in [(list\composite key_labels val_labels) [key_labelled val_labelled]]))) + kvs)] + (in [(list\mix list\composite (list) (list\each left =kvs)) + [ann (#Record (list\each right =kvs))]])) _ (in_meta [(list) code]))) @@ -5994,8 +6059,8 @@ [=raw (..embedded_expansions raw) .let [[labels labelled] =raw]] (in (list (` (with_expansions [(~+ (|> labels - (list\map (function (_ [label expansion]) (list label expansion))) - list\joined))] + (list\each (function (_ [label expansion]) (list label expansion))) + list\conjoint))] (~ labelled)))))) _ @@ -6018,13 +6083,13 @@ (-> Code (-> Code (Meta Code)) (-> (List [Code Code]) (Meta Code))) (do meta_monad - [=fields (monad\map meta_monad - (function (_ [key value]) - (do meta_monad - [=key (untemplated_pattern key) - =value (untemplated_pattern value)] - (in (` [(~ =key) (~ =value)])))) - fields)] + [=fields (monad\each meta_monad + (function (_ [key value]) + (do meta_monad + [=key (untemplated_pattern key) + =value (untemplated_pattern value)] + (in (` [(~ =key) (~ =value)])))) + fields)] (in (` [(~ g!meta) (#.Record (~ (untemplated_list =fields)))])))) (template [<tag> <name>] @@ -6035,12 +6100,12 @@ (#Item [_ (#Form (#Item [[_ (#Identifier ["" "~+"])] (#Item [spliced #End])]))] inits) (do meta_monad - [=inits (monad\map meta_monad untemplated_pattern (list\reversed inits))] + [=inits (monad\each meta_monad untemplated_pattern (list\reversed inits))] (in (` [(~ g!meta) (<tag> (~ (untemplated_list& spliced =inits)))]))) _ (do meta_monad - [=elems (monad\map meta_monad untemplated_pattern elems)] + [=elems (monad\each meta_monad untemplated_pattern elems)] (in (` [(~ g!meta) (<tag> (~ (untemplated_list =elems)))])))))] [#.Tuple untemplated_tuple] @@ -6073,8 +6138,8 @@ (^template [<tag> <untemplated>] [[_ (<tag> elems)] (<untemplated> g!meta untemplated_pattern elems)]) - ([#.Tuple ..untemplated_tuple] - [#.Form ..untemplated_form]) + ([#Tuple ..untemplated_tuple] + [#Form ..untemplated_form]) [_ (#Record fields)] (..untemplated_record g!meta untemplated_pattern fields) @@ -6122,9 +6187,9 @@ (if (multiple? 2 (list\size bindings)) (in_meta (list (` (..with_expansions [(~+ (|> bindings ..pairs - (list\map (function (_ [localT valueT]) - (list localT (` (..as_is (~ valueT)))))) - (list\mix list\compose (list))))] + (list\each (function (_ [localT valueT]) + (list localT (` (..as_is (~ valueT)))))) + (list\mix list\composite (list))))] (~ bodyT))))) (..failure ":let requires an even number of parts")) |