diff options
Diffstat (limited to 'stdlib/source/library')
269 files changed, 730 insertions, 661 deletions
diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux index 633ec16ce..13ff44b45 100644 --- a/stdlib/source/library/lux.lux +++ b/stdlib/source/library/lux.lux @@ -2027,7 +2027,7 @@ (-> Symbol ($' Meta Symbol)) ({["" name] (do meta_monad - [module_name current_module_name] + [module_name ..current_module_name] (in [module_name name])) _ @@ -2559,6 +2559,40 @@ _ {#None})) +(def:' .private (inP it tokens) + (All (_ a) + (-> a (Parser a))) + {#Some [tokens it]}) + +(def:' .private (orP leftP rightP tokens) + (All (_ l r) + (-> (Parser l) + (Parser r) + (Parser (Or l r)))) + (case (leftP tokens) + {#Some [tokens left]} + {#Some [tokens {#Left left}]} + + _ + (case (rightP tokens) + {#Some [tokens right]} + {#Some [tokens {#Right right}]} + + _ + {#None}))) + +(def:' .private (eitherP leftP rightP tokens) + (All (_ a) + (-> (Parser a) + (Parser a) + (Parser a))) + (case (leftP tokens) + {#None} + (rightP tokens) + + it + it)) + (def:' .private (andP leftP rightP tokens) (All (_ l r) (-> (Parser l) @@ -2571,6 +2605,16 @@ .let [[tokens right] right]] (in [tokens [left right]]))) +(def:' .private (afterP leftP rightP tokens) + (All (_ l r) + (-> (Parser l) + (Parser r) + (Parser r))) + (do maybe_monad + [left (leftP tokens) + .let [[tokens left] left]] + (rightP tokens))) + (def:' .private (someP itP tokens) (All (_ a) (-> (Parser a) @@ -2585,6 +2629,17 @@ {#None} {#Some [tokens (list)]})) +(def:' .private (manyP itP tokens) + (All (_ a) + (-> (Parser a) + (Parser (List a)))) + (do maybe_monad + [it (itP tokens) + .let [[tokens head] it] + it (someP itP tokens) + .let [[tokens tail] it]] + (in [tokens (partial_list head tail)]))) + (def:' .private (maybeP itP tokens) (All (_ a) (-> (Parser a) @@ -2600,9 +2655,21 @@ (All (_ a) (-> (Parser a) (Parser a))) (case tokens - (pattern (partial_list [_ {#Tuple tuple}] tokens')) + (pattern (partial_list [_ {#Tuple input}] tokens')) (do maybe_monad - [it (parsed itP tuple)] + [it (parsed itP input)] + (in [tokens' it])) + + _ + {#None})) + +(def:' .private (formP itP tokens) + (All (_ a) + (-> (Parser a) (Parser a))) + (case tokens + (pattern (partial_list [_ {#Form input}] tokens')) + (do maybe_monad + [it (parsed itP input)] (in [tokens' it])) _ @@ -2618,10 +2685,10 @@ {#None})) (def:' .private (endP tokens) - (-> (List Code) (Maybe Any)) + (Parser Any) (case tokens (pattern (list)) - {#Some []} + {#Some [tokens []]} _ {#None})) @@ -2644,6 +2711,15 @@ _ {#None})) +(def:' .private (globalP tokens) + (-> (List Code) (Maybe [(List Code) Symbol])) + (case tokens + (pattern (partial_list [_ {#Symbol it}] tokens')) + {#Some [tokens' it]} + + _ + {#None})) + (template [<parser> <item_type> <item_parser>] [(def:' .private (<parser> tokens) (-> (List Code) (Maybe (List <item_type>))) @@ -3375,24 +3451,14 @@ {#None} (failure "Wrong syntax for type:"))) -(type: Referrals - (Variant - {#Nothing} - {#Referral [Symbol (List Code)]})) - -(type: Openings - [Text (List Text)]) - -(type: Refer - (Record - [#refer_defs Referrals - #refer_open (List Openings)])) +(type: Referral + [Symbol (List Code)]) (type: Importation (Record [#import_name Text #import_alias (Maybe Text) - #import_refer Refer])) + #import_referrals (List Referral)])) ... TODO: Allow asking the compiler for the name of the definition ... currently being defined. That name can then be fed into @@ -3411,47 +3477,19 @@ _ (failure (..wrong_syntax_error [..prelude_module "symbol"])))) -(def: (referrals_parser aliased? tokens) - (-> Bit (List Code) (Meta [Referrals (List Code)])) - (case tokens - (pattern (partial_list [_ {#Form (partial_list [_ {#Symbol macro}] defs)}] tokens')) - (meta#in [{#Referral [macro defs]} - tokens']) - - (pattern (list)) - (meta#in [(if aliased? - {#Referral [(symbol ..only) (list)]} - {#Nothing}) - (list)]) - - _ - (meta#in [{#Nothing} - tokens]))) +(def: referral_parser + (Parser Referral) + (formP (andP globalP (someP anyP)))) -(def: (openings_parser parts) - (-> (List Code) (Meta [(List Openings) (List Code)])) - (case parts - {#End} - (meta#in [{#End} {#End}]) - - (pattern (partial_list [_ {#Form (partial_list [_ {#Text prefix}] structs)}] parts')) - (do meta_monad - [structs' (monad#each meta_monad - (function (_ struct) - (case struct - [_ {#Symbol ["" struct_name]}] - (meta#in struct_name) - - _ - (failure "Expected all implementations of opening form to be symbols."))) - structs) - next+remainder (openings_parser parts')] - (let [[next remainder] next+remainder] - (meta#in [{#Item [prefix structs'] next} - remainder]))) - - _ - (meta#in [{#End} parts]))) +(def: (referrals_parser aliased?) + (-> Bit (Parser (List Referral))) + (all eitherP + (manyP referral_parser) + (afterP endP + (inP (if aliased? + (list [(symbol ..only) (list)]) + (list)))) + (inP (list)))) (def: (text#split_at' at x) (-> Nat Text [Text Text]) @@ -3582,20 +3620,22 @@ {#None} (..absolute_module_name nested? relative_root module_name)) - referral+extra (referrals_parser #0 extra) - .let [[referral extra] referral+extra] - openings+extra (openings_parser extra) - .let [[openings extra] openings+extra] + extra,referral (case (referrals_parser #0 extra) + {#Some extra,referral} + (in extra,referral) + + {#None} + (failure "")) + .let [[extra referral] extra,referral] sub_imports (imports_parser #1 absolute_module_name context extra)] - (in (case [referral openings] - [{#Nothing} {#End}] + (in (case referral + {#End} sub_imports _ (partial_list [#import_name absolute_module_name #import_alias {#None} - #import_refer [#refer_defs referral - #refer_open openings]] + #import_referrals referral] sub_imports)))) (pattern [_ {#Tuple (partial_list [_ {#Text alias}] [_ {#Symbol ["" module_name]}] extra)}]) @@ -3606,21 +3646,23 @@ {#None} (..absolute_module_name nested? relative_root module_name)) - referral+extra (referrals_parser #1 extra) - .let [[referral extra] referral+extra] - openings+extra (openings_parser extra) - .let [[openings extra] openings+extra - module_alias (..module_alias {#Item module_name context} alias)] + extra,referral (case (referrals_parser #1 extra) + {#Some extra,referral} + (in extra,referral) + + {#None} + (failure "")) + .let [[extra referral] extra,referral] + .let [module_alias (..module_alias {#Item module_name context} alias)] sub_imports (imports_parser #1 absolute_module_name {#Item module_alias context} extra)] - (in (case [referral openings] - [{#Nothing} {#End}] + (in (case referral + {#End} sub_imports _ (partial_list [#import_name absolute_module_name #import_alias {#Some module_alias} - #import_refer [#refer_defs referral - #refer_open openings]] + #import_referrals referral] sub_imports)))) ... Unrecognized syntax. @@ -3724,9 +3766,10 @@ (case (..parsed (all ..andP ..textP ..textP + ..textP (..someP ..localP)) tokens) - {.#Some [current_module imported_module actual]} + {.#Some [current_module imported_module import_alias actual]} (do meta_monad [expected (exported_definitions imported_module) _ (test_referrals current_module imported_module expected actual)] @@ -3751,9 +3794,10 @@ (case (..parsed (all ..andP ..textP ..textP + ..textP (..someP ..localP)) tokens) - {.#Some [current_module imported_module actual]} + {.#Some [current_module imported_module import_alias actual]} (do meta_monad [expected (exported_definitions imported_module) _ (test_referrals current_module imported_module expected actual)] @@ -4059,8 +4103,8 @@ _ (failure "Wrong syntax for the"))) -(def: (open_declaration alias tags my_tag_index [module short] source type) - (-> Text (List Symbol) Nat Symbol Code Type (Meta (List Code))) +(def: (open_declaration imported_module alias tags my_tag_index [module short] source type) + (-> Text Text (List Symbol) Nat Symbol Code Type (Meta (List Code))) (do meta_monad [output (record_slots type) g!_ (..generated_symbol "g!_") @@ -4079,44 +4123,100 @@ [decls' (monad#each meta_monad (is (-> [Nat Symbol Type] (Meta (List Code))) (function (_ [sub_tag_index sname stype]) - (open_declaration alias tags' sub_tag_index sname source+ stype))) + (open_declaration imported_module alias tags' sub_tag_index sname source+ stype))) (enumeration (zipped_2 tags' members')))] - (meta#in (list#conjoint decls'))) + (in (list#conjoint decls'))) _ - (meta#in (list (` ("lux def" (~ (local$ (..module_alias (list short) alias))) - (~ source+) - #0))))))) + (in (list (` ("lux def" (~ (local$ (..module_alias (list short imported_module) alias))) + (~ source+) + #0))))))) -(macro: .public (open: tokens) - (case tokens - (pattern (list [_ {#Text alias}] struct)) - (case struct - [_ {#Symbol struct_name}] +(def: (implementation_declarations imported_module alias implementation) + (-> Text Text Symbol (Meta (List Code))) + (do meta_monad + [interface (type_definition implementation) + output (record_slots interface)] + (case output + {#Some [slots terms]} (do meta_monad - [struct_type (type_definition struct_name) - output (record_slots struct_type) - .let [source (symbol$ struct_name)]] - (case output - {#Some [tags members]} - (do meta_monad - [decls' (monad#each meta_monad (is (-> [Nat Symbol Type] (Meta (List Code))) - (function (_ [tag_index sname stype]) - (open_declaration alias tags tag_index sname source stype))) - (enumeration (zipped_2 tags members)))] - (meta#in (list#conjoint decls'))) - - _ - (failure (text#composite "Can only 'open:' structs: " (type#encoded struct_type))))) + [.let [g!implementation (symbol$ implementation)] + declarations (monad#each meta_monad (is (-> [Nat Symbol Type] (Meta (List Code))) + (function (_ [index slot_label slot_type]) + (open_declaration imported_module alias slots index slot_label g!implementation slot_type))) + (enumeration (zipped_2 slots terms)))] + (in (list#conjoint declarations))) _ - (do meta_monad - [g!struct (..generated_symbol "struct")] - (meta#in (list (` ("lux def" (~ g!struct) (~ struct) #0)) - (` (..open: (~ (text$ alias)) (~ g!struct))))))) + (failure (all text#composite + "Can only 'open:' structs: " (symbol#encoded implementation) + " : " (type#encoded interface)))))) + +(def: (localized module global) + (-> Text Symbol Symbol) + (case global + ["" local] + [module local] _ - (failure "Wrong syntax for open:"))) + global)) + +(macro: .public (open: tokens) + (case (..parsed (all ..andP + (..maybeP (all ..andP + ..textP + ..textP + ..textP)) + ..textP + (..orP (..manyP ..globalP) + (..manyP ..anyP))) + tokens) + {.#Some [current_module,imported_module,import_alias alias implementations]} + (let [[current_module imported_module import_alias] + (case current_module,imported_module,import_alias + {#Some [current_module imported_module import_alias]} + [current_module imported_module import_alias] + + {#None} + ["" "" ""])] + (case implementations + {#Left implementations} + (do meta_monad + [declarations (|> implementations + (list#each (localized imported_module)) + (monad#each meta_monad (implementation_declarations import_alias alias)))] + (in (list#conjoint declarations))) + + {#Right implementations} + (do meta_monad + [pre_defs,implementations (is (Meta [(List Code) (List Code)]) + (monad#mix meta_monad + (function (_ it [pre_defs implementations]) + (case it + [_ {#Symbol _}] + (in [pre_defs + {#Item it implementations}]) + + _ + (do meta_monad + [g!implementation (..generated_symbol "implementation")] + (in [{#Item (` ("lux def" (~ g!implementation) (~ it) #0)) pre_defs} + {#Item g!implementation implementations}])))) + [(list) (list)] + implementations)) + .let [[pre_defs implementations] pre_defs,implementations]] + (in (|> pre_defs + {#Item (` (..open: + (~ (text$ current_module)) + (~ (text$ imported_module)) + (~ (text$ import_alias)) + (~ (text$ alias)) + (~+ implementations)))} + list#reversed))))) + + + {.#None} + (failure (..wrong_syntax_error (symbol ..open:))))) (def: (imported_by? import_name module_name) (-> Text Text (Meta Bit)) @@ -4125,85 +4225,45 @@ .let [[..#module_hash _ ..#module_aliases _ ..#definitions _ ..#imports imports ..#module_state _] module]] (in (is_member? imports import_name)))) -(def: (referrals module_name options) - (-> Text (List Code) (Meta Refer)) +(def: (referrals module_name extra) + (-> Text (List Code) (Meta (List Referral))) (do meta_monad - [referral+options (referrals_parser #0 options) - .let [[referral options] referral+options] - openings+options (openings_parser options) - .let [[openings options] openings+options] + [extra,referral (case (referrals_parser #0 extra) + {#Some extra,referral} + (in extra,referral) + + {#None} + (failure "")) + .let [[extra referral] extra,referral] current_module current_module_name] - (case options + (case extra {#End} - (in [#refer_defs referral - #refer_open openings]) + (in referral) _ (failure (all text#composite "Wrong syntax for refer @ " current_module - \n (|> options + \n (|> extra (list#each code#encoded) (list#interposed " ") (list#mix text#composite ""))))))) -(def: (referral_definitions module_name [r_defs r_opens]) - (-> Text Refer (Meta (List Code))) - (do meta_monad - [current_module ..current_module_name - .let [test_referrals (is (-> Text (List Text) (List Text) (Meta (List Any))) - (function (_ module_name all_defs referred_defs) - (monad#each meta_monad - (is (-> Text (Meta Any)) - (function (_ _def) - (if (is_member? all_defs _def) - (meta#in []) - (failure (all text#composite _def " is not defined in module " module_name " @ " current_module))))) - referred_defs)))] - defs (case r_defs - {#Nothing} - (in (list)) - - {#Referral [macro parameters]} - (single_expansion (` ((~ (symbol$ macro)) - (~ (text$ current_module)) - (~ (text$ module_name)) - (~+ parameters))))) - .let [openings (|> r_opens - (list#each (is (-> Openings (List Code)) - (function (_ [alias structs]) - (list#each (function (_ name) - (` (open: (~ (text$ alias)) (~ (symbol$ [module_name name]))))) - structs)))) - list#conjoint)]] - (in (list#composite defs openings)))) - (macro: (refer tokens) (case tokens - (pattern (partial_list [_ {#Text module_name}] options)) + (pattern (partial_list [_ {#Text imported_module}] [_ {#Text alias}] options)) (do meta_monad - [=refer (referrals module_name options)] - (referral_definitions module_name =refer)) + [referrals (..referrals imported_module options) + current_module ..current_module_name] + (in (list#each (function (_ [macro parameters]) + (` ((~ (symbol$ macro)) + (~ (text$ current_module)) + (~ (text$ imported_module)) + (~ (text$ alias)) + (~+ parameters)))) + referrals))) _ (failure "Wrong syntax for refer"))) -(def: (refer_code module_name module_alias' [r_defs r_opens]) - (-> Text (Maybe Text) Refer Code) - (let [module_alias (..maybe#else module_name module_alias') - localizations (is (List Code) - (case r_defs - {#Nothing} - (list) - - {#Referral [macro parameters]} - (list (` ((~ (symbol$ macro)) (~+ parameters)))))) - openings (list#each (function (_ [alias structs]) - (form$ (partial_list (text$ (..module_alias (list (alias_stand_in 0) module_alias) alias)) - (list#each local$ structs)))) - r_opens)] - (` ((~! ..refer) (~ (text$ module_name)) - (~+ localizations) - (~+ openings))))) - (macro: .public (# tokens) (case tokens (pattern (list struct [_ {#Symbol member}])) @@ -4891,6 +4951,15 @@ (failure (..wrong_syntax_error (symbol ..$)))))) (these (def: .public parameter ""))) +(def: (refer_code imported_module alias referrals) + (-> Text Text (List Referral) Code) + (` ((~! ..refer) + (~ (text$ imported_module)) + (~ (text$ alias)) + (~+ (list#each (function (_ [macro parameters]) + (` ((~ (symbol$ macro)) (~+ parameters)))) + referrals))))) + (macro: .public (using _imports) (do meta_monad [current_module ..current_module_name @@ -4902,7 +4971,7 @@ tuple$) =refers (list#each (is (-> Importation Code) (function (_ [module_name m_alias =refer]) - (refer_code module_name m_alias =refer))) + (refer_code module_name (..maybe#else "" m_alias) =refer))) imports) =module (` ("lux def module" (~ =imports)))] g!_ (..generated_symbol "")] diff --git a/stdlib/source/library/lux/abstract/comonad.lux b/stdlib/source/library/lux/abstract/comonad.lux index 2660ba081..5bb928e6a 100644 --- a/stdlib/source/library/lux/abstract/comonad.lux +++ b/stdlib/source/library/lux/abstract/comonad.lux @@ -3,7 +3,7 @@ [lux (.except) [data [collection - ["[0]" list ("[1]#[0]" mix)]]] + ["[0]" list (.open: "[1]#[0]" mix)]]] [math [number ["n" nat]]] diff --git a/stdlib/source/library/lux/abstract/monad/indexed.lux b/stdlib/source/library/lux/abstract/monad/indexed.lux index ad28a2649..0894b4021 100644 --- a/stdlib/source/library/lux/abstract/monad/indexed.lux +++ b/stdlib/source/library/lux/abstract/monad/indexed.lux @@ -6,7 +6,7 @@ ["<[0]>" code (.only Parser)]]] [data [collection - ["[0]" list ("[1]#[0]" functor mix)]]] + ["[0]" list (.open: "[1]#[0]" functor mix)]]] ["[0]" macro (.only) [syntax (.only syntax:)] ["[0]" code]]]] diff --git a/stdlib/source/library/lux/control/concatenative.lux b/stdlib/source/library/lux/control/concatenative.lux index e53790026..a10e6e906 100644 --- a/stdlib/source/library/lux/control/concatenative.lux +++ b/stdlib/source/library/lux/control/concatenative.lux @@ -5,12 +5,12 @@ [abstract ["[0]" monad]] [control - ["[0]" maybe ("[1]#[0]" monad)]] + ["[0]" maybe (.open: "[1]#[0]" monad)]] [data ["[0]" text (.only) ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" mix functor)]]] + ["[0]" list (.open: "[1]#[0]" mix functor)]]] ["[0]" macro (.only with_symbols) ["[0]" code] ["[0]" template] @@ -23,7 +23,7 @@ ["r" rev] ["f" frac]]]]] [// - ["<>" parser ("[1]#[0]" monad) + ["<>" parser (.open: "[1]#[0]" monad) ["<[0]>" code (.only Parser)]]]) (type: Alias diff --git a/stdlib/source/library/lux/control/concurrency/actor.lux b/stdlib/source/library/lux/control/concurrency/actor.lux index 17d986c44..b1d80473c 100644 --- a/stdlib/source/library/lux/control/concurrency/actor.lux +++ b/stdlib/source/library/lux/control/concurrency/actor.lux @@ -10,7 +10,7 @@ ["[0]" try (.only Try)] ["[0]" exception (.only exception:)] ["[0]" io (.only IO io)] - ["<>" parser ("[1]#[0]" monad) + ["<>" parser (.open: "[1]#[0]" monad) ["<[0]>" code (.only Parser)]]] [data ["[0]" bit] @@ -18,7 +18,7 @@ [text ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" monoid monad)]]] + ["[0]" list (.open: "[1]#[0]" monoid monad)]]] ["[0]" macro (.only with_symbols) ["[0]" code] [syntax (.only syntax:) @@ -32,7 +32,7 @@ ["[0]" primitive (.only primitive: representation abstraction)]]]] [// ["[0]" atom (.only Atom atom)] - ["[0]" async (.only Async Resolver) ("[1]#[0]" monad)] + ["[0]" async (.only Async Resolver) (.open: "[1]#[0]" monad)] ["[0]" frp (.only Channel Channel')]]) (exception: .public poisoned) diff --git a/stdlib/source/library/lux/control/concurrency/async.lux b/stdlib/source/library/lux/control/concurrency/async.lux index 430637d8b..6fff72d48 100644 --- a/stdlib/source/library/lux/control/concurrency/async.lux +++ b/stdlib/source/library/lux/control/concurrency/async.lux @@ -9,7 +9,7 @@ ["[0]" pipe] ["[0]" function] ["[0]" io (.only IO io)] - ["[0]" maybe ("[1]#[0]" functor)]] + ["[0]" maybe (.open: "[1]#[0]" functor)]] [data ["[0]" product]] [macro diff --git a/stdlib/source/library/lux/control/concurrency/atom.lux b/stdlib/source/library/lux/control/concurrency/atom.lux index da13c860d..ba861725f 100644 --- a/stdlib/source/library/lux/control/concurrency/atom.lux +++ b/stdlib/source/library/lux/control/concurrency/atom.lux @@ -7,7 +7,7 @@ [monad (.only do)]] [control ["[0]" function] - ["[0]" io (.only IO) ("[1]#[0]" functor)]] + ["[0]" io (.only IO) (.open: "[1]#[0]" functor)]] [data ["[0]" product] [collection diff --git a/stdlib/source/library/lux/control/concurrency/frp.lux b/stdlib/source/library/lux/control/concurrency/frp.lux index a4b99b6f4..252b8f0ce 100644 --- a/stdlib/source/library/lux/control/concurrency/frp.lux +++ b/stdlib/source/library/lux/control/concurrency/frp.lux @@ -7,7 +7,7 @@ [apply (.only Apply)] ["[0]" monad (.only Monad do)]] [control - ["[0]" maybe ("[1]#[0]" functor)] + ["[0]" maybe (.open: "[1]#[0]" functor)] ["[0]" try (.only Try)] ["[0]" exception (.only exception:)] ["[0]" io (.only IO io)]] @@ -15,7 +15,7 @@ ["[0]" variance (.only Mutable)]]]] [// ["[0]" atom (.only Atom)] - ["[0]" async (.only Async Async') ("[1]#[0]" monad)]]) + ["[0]" async (.only Async Async') (.open: "[1]#[0]" monad)]]) (type: .public (Channel'' a) (Async (Maybe [a (Channel'' a)]))) diff --git a/stdlib/source/library/lux/control/exception.lux b/stdlib/source/library/lux/control/exception.lux index 34bdd22c2..7aed1de63 100644 --- a/stdlib/source/library/lux/control/exception.lux +++ b/stdlib/source/library/lux/control/exception.lux @@ -7,13 +7,13 @@ [monad (.only do)]] [control ["[0]" maybe] - ["<>" parser ("[1]#[0]" monad) + ["<>" parser (.open: "[1]#[0]" monad) ["<[0]>" code (.only Parser)]]] [data ["[0]" product] - ["[0]" text ("[1]#[0]" monoid)] + ["[0]" text (.open: "[1]#[0]" monoid)] [collection - ["[0]" list ("[1]#[0]" functor mix)]]] + ["[0]" list (.open: "[1]#[0]" functor mix)]]] [macro ["[0]" code] [syntax (.only syntax:) @@ -22,7 +22,7 @@ ["|[1]_[0]|" variable]]]] [math [number - ["n" nat ("[1]#[0]" decimal)]]]]] + ["n" nat (.open: "[1]#[0]" decimal)]]]]] [// ["//" try (.only Try)]]) diff --git a/stdlib/source/library/lux/control/function/inline.lux b/stdlib/source/library/lux/control/function/inline.lux index 38e1c795f..ac13d65df 100644 --- a/stdlib/source/library/lux/control/function/inline.lux +++ b/stdlib/source/library/lux/control/function/inline.lux @@ -9,7 +9,7 @@ ["<[0]>" code (.only Parser)]]] [data [collection - ["[0]" list ("[1]#[0]" monad)]]] + ["[0]" list (.open: "[1]#[0]" monad)]]] ["[0]" macro (.only) ["[0]" code] [syntax (.only syntax:) diff --git a/stdlib/source/library/lux/control/function/mutual.lux b/stdlib/source/library/lux/control/function/mutual.lux index 65b8b9a6b..03ea12a04 100644 --- a/stdlib/source/library/lux/control/function/mutual.lux +++ b/stdlib/source/library/lux/control/function/mutual.lux @@ -7,14 +7,14 @@ [control ["[0]" try (.only Try)] ["[0]" exception (.only exception:)] - ["<>" parser ("[1]#[0]" monad) + ["<>" parser (.open: "[1]#[0]" monad) ["<[0]>" code (.only Parser)]]] [data ["[0]" product] [text ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" functor)] + ["[0]" list (.open: "[1]#[0]" functor)] [dictionary ["[0]" plist (.only PList)]]]] ["[0]" macro (.only) diff --git a/stdlib/source/library/lux/control/parser.lux b/stdlib/source/library/lux/control/parser.lux index 052f89a98..c842910c7 100644 --- a/stdlib/source/library/lux/control/parser.lux +++ b/stdlib/source/library/lux/control/parser.lux @@ -11,7 +11,7 @@ [data ["[0]" product] [collection - ["[0]" list ("[1]#[0]" functor monoid)]]] + ["[0]" list (.open: "[1]#[0]" functor monoid)]]] [math [number ["n" nat]]]]]) diff --git a/stdlib/source/library/lux/control/parser/analysis.lux b/stdlib/source/library/lux/control/parser/analysis.lux index d6fb20e2b..60b8edb63 100644 --- a/stdlib/source/library/lux/control/parser/analysis.lux +++ b/stdlib/source/library/lux/control/parser/analysis.lux @@ -11,7 +11,7 @@ ["[0]" text (.only) ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" functor)]]] + ["[0]" list (.open: "[1]#[0]" functor)]]] [macro ["[0]" template]] [math diff --git a/stdlib/source/library/lux/control/parser/binary.lux b/stdlib/source/library/lux/control/parser/binary.lux index e566a58a5..f9871b53b 100644 --- a/stdlib/source/library/lux/control/parser/binary.lux +++ b/stdlib/source/library/lux/control/parser/binary.lux @@ -29,7 +29,7 @@ [number ["n" nat] ["[0]" frac]]]]] - ["[0]" // ("[1]#[0]" monad)]) + ["[0]" // (.open: "[1]#[0]" monad)]) (type: .public Offset Nat) diff --git a/stdlib/source/library/lux/control/parser/cli.lux b/stdlib/source/library/lux/control/parser/cli.lux index 31ff5bef0..74b184d05 100644 --- a/stdlib/source/library/lux/control/parser/cli.lux +++ b/stdlib/source/library/lux/control/parser/cli.lux @@ -6,7 +6,7 @@ [control ["[0]" try (.only Try)]] [data - ["[0]" text ("[1]#[0]" equivalence) + ["[0]" text (.open: "[1]#[0]" equivalence) ["%" format (.only format)]]]]] ["[0]" //]) diff --git a/stdlib/source/library/lux/control/parser/code.lux b/stdlib/source/library/lux/control/parser/code.lux index 4ab009d74..8ac364a2a 100644 --- a/stdlib/source/library/lux/control/parser/code.lux +++ b/stdlib/source/library/lux/control/parser/code.lux @@ -7,11 +7,11 @@ ["[0]" try (.only Try)]] [data ["[0]" bit] - ["[0]" text ("[1]#[0]" monoid)] + ["[0]" text (.open: "[1]#[0]" monoid)] [collection - ["[0]" list ("[1]#[0]" functor)]]] + ["[0]" list (.open: "[1]#[0]" functor)]]] [macro - ["[0]" code ("[1]#[0]" equivalence)]] + ["[0]" code (.open: "[1]#[0]" equivalence)]] [math [number ["[0]" nat] diff --git a/stdlib/source/library/lux/control/parser/json.lux b/stdlib/source/library/lux/control/parser/json.lux index 874833004..61bad3146 100644 --- a/stdlib/source/library/lux/control/parser/json.lux +++ b/stdlib/source/library/lux/control/parser/json.lux @@ -8,9 +8,9 @@ ["[0]" exception (.only exception:)]] [data ["[0]" bit] - ["[0]" text ("[1]#[0]" equivalence monoid)] + ["[0]" text (.open: "[1]#[0]" equivalence monoid)] [collection - ["[0]" list ("[1]#[0]" functor)] + ["[0]" list (.open: "[1]#[0]" functor)] ["[0]" sequence] ["[0]" dictionary (.only Dictionary)]] [format @@ -20,7 +20,7 @@ [math [number ["[0]" frac]]]]] - ["[0]" // ("[1]#[0]" functor)]) + ["[0]" // (.open: "[1]#[0]" functor)]) (type: .public (Parser a) (//.Parser (List JSON) a)) diff --git a/stdlib/source/library/lux/control/parser/text.lux b/stdlib/source/library/lux/control/parser/text.lux index 7cc34c955..4b8ab6e24 100644 --- a/stdlib/source/library/lux/control/parser/text.lux +++ b/stdlib/source/library/lux/control/parser/text.lux @@ -8,17 +8,17 @@ ["[0]" try (.only Try)] ["[0]" exception (.only exception:)]] [data - ["/" text (.only Char) ("[1]#[0]" monoid)] + ["/" text (.only Char) (.open: "[1]#[0]" monoid)] ["[0]" product] [collection - ["[0]" list ("[1]#[0]" mix)]]] + ["[0]" list (.open: "[1]#[0]" mix)]]] [macro ["^" pattern] ["[0]" code] ["[0]" template]] [math [number - ["n" nat ("[1]#[0]" decimal)]]]]] + ["n" nat (.open: "[1]#[0]" decimal)]]]]] ["[0]" //]) (type: .public Offset diff --git a/stdlib/source/library/lux/control/parser/type.lux b/stdlib/source/library/lux/control/parser/type.lux index cbb4884b9..944e687c7 100644 --- a/stdlib/source/library/lux/control/parser/type.lux +++ b/stdlib/source/library/lux/control/parser/type.lux @@ -8,18 +8,18 @@ ["[0]" exception (.only exception:)] ["[0]" function]] [data - ["[0]" text ("[1]#[0]" monoid) + ["[0]" text (.open: "[1]#[0]" monoid) ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" functor)] + ["[0]" list (.open: "[1]#[0]" functor)] ["[0]" dictionary (.only Dictionary)]]] [macro ["^" pattern] ["[0]" code]] [math [number - ["n" nat ("[1]#[0]" decimal)]]] - ["[0]" type ("[1]#[0]" equivalence) + ["n" nat (.open: "[1]#[0]" decimal)]]] + ["[0]" type (.open: "[1]#[0]" equivalence) ["[0]" check]]]] ["[0]" //]) diff --git a/stdlib/source/library/lux/control/parser/xml.lux b/stdlib/source/library/lux/control/parser/xml.lux index 36b62f782..6853965af 100644 --- a/stdlib/source/library/lux/control/parser/xml.lux +++ b/stdlib/source/library/lux/control/parser/xml.lux @@ -4,7 +4,7 @@ [abstract [monad (.only do)]] [control - ["[0]" try (.only Try) ("[1]#[0]" functor)] + ["[0]" try (.only Try) (.open: "[1]#[0]" functor)] ["[0]" exception (.only exception:)]] [data ["[0]" text @@ -15,7 +15,7 @@ [format ["/" xml (.only Attribute Attrs Tag XML)]]] [meta - ["[0]" symbol ("[1]#[0]" equivalence codec)]]]] + ["[0]" symbol (.open: "[1]#[0]" equivalence codec)]]]] ["[0]" //]) (type: .public (Parser a) diff --git a/stdlib/source/library/lux/control/pipe.lux b/stdlib/source/library/lux/control/pipe.lux index 4e352584c..4f5e3298c 100644 --- a/stdlib/source/library/lux/control/pipe.lux +++ b/stdlib/source/library/lux/control/pipe.lux @@ -10,7 +10,7 @@ [data ["[0]" identity] [collection - ["[0]" list ("[1]#[0]" monad)]]] + ["[0]" list (.open: "[1]#[0]" monad)]]] [macro (.only with_symbols) [syntax (.only syntax:)] ["[0]" code]] diff --git a/stdlib/source/library/lux/control/region.lux b/stdlib/source/library/lux/control/region.lux index 86bddcfac..f744c5cef 100644 --- a/stdlib/source/library/lux/control/region.lux +++ b/stdlib/source/library/lux/control/region.lux @@ -11,7 +11,7 @@ ["[0]" text (.only) ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" mix)]]]]] + ["[0]" list (.open: "[1]#[0]" mix)]]]]] [// ["[0]" exception (.only Exception exception:)]]) diff --git a/stdlib/source/library/lux/control/remember.lux b/stdlib/source/library/lux/control/remember.lux index e19b39036..4f4bd74f2 100644 --- a/stdlib/source/library/lux/control/remember.lux +++ b/stdlib/source/library/lux/control/remember.lux @@ -7,14 +7,14 @@ ["[0]" io] ["[0]" try] ["[0]" exception (.only exception:)] - ["<>" parser ("[1]#[0]" functor) + ["<>" parser (.open: "[1]#[0]" functor) ["<c>" code (.only Parser)]]] [data ["[0]" text ["%" format (.only format)]]] [time ["[0]" instant] - ["[0]" date (.only Date) ("[1]#[0]" order)]] + ["[0]" date (.only Date) (.open: "[1]#[0]" order)]] ["[0]" meta] [macro ["[0]" code] diff --git a/stdlib/source/library/lux/control/security/capability.lux b/stdlib/source/library/lux/control/security/capability.lux index 3317a8f15..82b7a9a86 100644 --- a/stdlib/source/library/lux/control/security/capability.lux +++ b/stdlib/source/library/lux/control/security/capability.lux @@ -13,7 +13,7 @@ [text ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" functor)]]] + ["[0]" list (.open: "[1]#[0]" functor)]]] [type [primitive (.except)]] ["[0]" meta] diff --git a/stdlib/source/library/lux/data/collection/bits.lux b/stdlib/source/library/lux/data/collection/bits.lux index b2ef8d6f2..e9b659d3a 100644 --- a/stdlib/source/library/lux/data/collection/bits.lux +++ b/stdlib/source/library/lux/data/collection/bits.lux @@ -8,7 +8,7 @@ ["[0]" maybe]] [data [collection - ["[0]" array (.only Array) ("[1]#[0]" mix)]]] + ["[0]" array (.only Array) (.open: "[1]#[0]" mix)]]] [math [number ["n" nat] diff --git a/stdlib/source/library/lux/data/collection/dictionary.lux b/stdlib/source/library/lux/data/collection/dictionary.lux index 7f30db024..5fc1d3ebb 100644 --- a/stdlib/source/library/lux/data/collection/dictionary.lux +++ b/stdlib/source/library/lux/data/collection/dictionary.lux @@ -13,7 +13,7 @@ [data ["[0]" product] [collection - ["[0]" list ("[1]#[0]" mix functor monoid)] + ["[0]" list (.open: "[1]#[0]" mix functor monoid)] ["[0]" array ["[1]" \\unsafe (.only Array)]]]] [macro diff --git a/stdlib/source/library/lux/data/collection/dictionary/ordered.lux b/stdlib/source/library/lux/data/collection/dictionary/ordered.lux index 16361edf6..46889f723 100644 --- a/stdlib/source/library/lux/data/collection/dictionary/ordered.lux +++ b/stdlib/source/library/lux/data/collection/dictionary/ordered.lux @@ -10,7 +10,7 @@ [data ["p" product] [collection - ["[0]" list ("[1]#[0]" monoid mix)]]] + ["[0]" list (.open: "[1]#[0]" monoid mix)]]] [macro ["^" pattern]] [math diff --git a/stdlib/source/library/lux/data/collection/dictionary/plist.lux b/stdlib/source/library/lux/data/collection/dictionary/plist.lux index 1c5528026..1d7c385c2 100644 --- a/stdlib/source/library/lux/data/collection/dictionary/plist.lux +++ b/stdlib/source/library/lux/data/collection/dictionary/plist.lux @@ -5,12 +5,12 @@ [equivalence (.only Equivalence)] [monoid (.only Monoid)]] [control - ["[0]" maybe ("[1]#[0]" functor)]] + ["[0]" maybe (.open: "[1]#[0]" functor)]] [data ["[0]" product] - ["[0]" text ("[1]#[0]" equivalence)] + ["[0]" text (.open: "[1]#[0]" equivalence)] [collection - ["[0]" list ("[1]#[0]" functor mix)]]] + ["[0]" list (.open: "[1]#[0]" functor mix)]]] [math [number ["n" nat]]]]]) diff --git a/stdlib/source/library/lux/data/collection/queue.lux b/stdlib/source/library/lux/data/collection/queue.lux index bde5d6525..103e38506 100644 --- a/stdlib/source/library/lux/data/collection/queue.lux +++ b/stdlib/source/library/lux/data/collection/queue.lux @@ -6,7 +6,7 @@ [functor (.only Functor)]] [data [collection - ["[0]" list ("[1]#[0]" monoid functor)]]] + ["[0]" list (.open: "[1]#[0]" monoid functor)]]] [math [number ["n" nat]]]]]) diff --git a/stdlib/source/library/lux/data/collection/queue/priority.lux b/stdlib/source/library/lux/data/collection/queue/priority.lux index 98c9734fb..7ff7d3195 100644 --- a/stdlib/source/library/lux/data/collection/queue/priority.lux +++ b/stdlib/source/library/lux/data/collection/queue/priority.lux @@ -12,7 +12,7 @@ ["[1]" finger (.only Tree)]]]] [math [number - ["n" nat ("[1]#[0]" interval)]]] + ["n" nat (.open: "[1]#[0]" interval)]]] [type (.only by_example) [primitive (.only primitive: abstraction representation)]]]]) diff --git a/stdlib/source/library/lux/data/collection/sequence.lux b/stdlib/source/library/lux/data/collection/sequence.lux index 065bb8941..2c8fdadaa 100644 --- a/stdlib/source/library/lux/data/collection/sequence.lux +++ b/stdlib/source/library/lux/data/collection/sequence.lux @@ -14,7 +14,7 @@ [mix (.only Mix)] [predicate (.only Predicate)]] [control - ["[0]" maybe ("[1]#[0]" functor)] + ["[0]" maybe (.open: "[1]#[0]" functor)] ["[0]" try (.only Try)] ["[0]" exception (.only exception:)] ["<>" parser (.only) @@ -22,7 +22,7 @@ [data ["[0]" product] [collection - ["[0]" list ("[1]#[0]" mix functor monoid)] + ["[0]" list (.open: "[1]#[0]" mix functor monoid)] ["[0]" array ["[1]" \\unsafe (.only Array)]]]] [macro diff --git a/stdlib/source/library/lux/data/collection/set.lux b/stdlib/source/library/lux/data/collection/set.lux index 4d9e696d9..bd82175ab 100644 --- a/stdlib/source/library/lux/data/collection/set.lux +++ b/stdlib/source/library/lux/data/collection/set.lux @@ -8,7 +8,7 @@ [monoid (.only Monoid)]] [data [collection - ["[0]" list ("[1]#[0]" mix)]]] + ["[0]" list (.open: "[1]#[0]" mix)]]] [macro ["^" pattern]] [math diff --git a/stdlib/source/library/lux/data/collection/set/multi.lux b/stdlib/source/library/lux/data/collection/set/multi.lux index 377ee54fd..30ca10e23 100644 --- a/stdlib/source/library/lux/data/collection/set/multi.lux +++ b/stdlib/source/library/lux/data/collection/set/multi.lux @@ -17,7 +17,7 @@ ["[0]" primitive (.only primitive: abstraction representation)]]]] ["[0]" // (.only) [// - ["[0]" list ("[1]#[0]" mix monoid)] + ["[0]" list (.open: "[1]#[0]" mix monoid)] ["[0]" dictionary (.only Dictionary)]]]) (primitive: .public (Set a) diff --git a/stdlib/source/library/lux/data/collection/set/ordered.lux b/stdlib/source/library/lux/data/collection/set/ordered.lux index 45ab47ef6..f55418053 100644 --- a/stdlib/source/library/lux/data/collection/set/ordered.lux +++ b/stdlib/source/library/lux/data/collection/set/ordered.lux @@ -6,7 +6,7 @@ [order (.only Order)]] [data [collection - ["[0]" list ("[1]#[0]" mix)] + ["[0]" list (.open: "[1]#[0]" mix)] [dictionary ["/" ordered]]]] [type diff --git a/stdlib/source/library/lux/data/collection/stream.lux b/stdlib/source/library/lux/data/collection/stream.lux index d62f1f23c..ac6a8c50e 100644 --- a/stdlib/source/library/lux/data/collection/stream.lux +++ b/stdlib/source/library/lux/data/collection/stream.lux @@ -11,7 +11,7 @@ [data ["[0]" bit] [collection - ["[0]" list ("[1]#[0]" monad)]]] + ["[0]" list (.open: "[1]#[0]" monad)]]] [macro (.only with_symbols) [syntax (.only syntax:)] ["[0]" code]] diff --git a/stdlib/source/library/lux/data/collection/tree.lux b/stdlib/source/library/lux/data/collection/tree.lux index 28d6f283b..f7dfcf617 100644 --- a/stdlib/source/library/lux/data/collection/tree.lux +++ b/stdlib/source/library/lux/data/collection/tree.lux @@ -11,7 +11,7 @@ ["<[0]>" code (.only Parser)]]] [data [collection - ["[0]" list ("[1]#[0]" monad mix)]]] + ["[0]" list (.open: "[1]#[0]" monad mix)]]] [macro [syntax (.only syntax:)] ["[0]" code]]]]) diff --git a/stdlib/source/library/lux/data/collection/tree/finger.lux b/stdlib/source/library/lux/data/collection/tree/finger.lux index a147973fe..1e2b87d25 100644 --- a/stdlib/source/library/lux/data/collection/tree/finger.lux +++ b/stdlib/source/library/lux/data/collection/tree/finger.lux @@ -6,7 +6,7 @@ ["[0]" monoid (.only Monoid)]] [data [collection - ["[0]" list ("[1]#[0]" monoid)]]] + ["[0]" list (.open: "[1]#[0]" monoid)]]] [type [primitive (.only primitive: abstraction representation)]]]]) diff --git a/stdlib/source/library/lux/data/collection/tree/zipper.lux b/stdlib/source/library/lux/data/collection/tree/zipper.lux index 713fa19c6..33bc9b1b6 100644 --- a/stdlib/source/library/lux/data/collection/tree/zipper.lux +++ b/stdlib/source/library/lux/data/collection/tree/zipper.lux @@ -8,14 +8,14 @@ [monad (.only do)] [equivalence (.only Equivalence)]] [control - ["[0]" maybe ("[1]#[0]" monad)]] + ["[0]" maybe (.open: "[1]#[0]" monad)]] [data ["[0]" product] [text ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" functor monoid)]]]]] - ["[0]" // (.only Tree) ("[1]#[0]" functor)]) + ["[0]" list (.open: "[1]#[0]" functor monoid)]]]]] + ["[0]" // (.only Tree) (.open: "[1]#[0]" functor)]) (type: (Family Zipper a) (Record diff --git a/stdlib/source/library/lux/data/color.lux b/stdlib/source/library/lux/data/color.lux index e18ee549c..ebc8f8371 100644 --- a/stdlib/source/library/lux/data/color.lux +++ b/stdlib/source/library/lux/data/color.lux @@ -7,13 +7,13 @@ ["[0]" hash (.only Hash)]] [data [collection - ["[0]" list ("[1]#[0]" functor)]]] + ["[0]" list (.open: "[1]#[0]" functor)]]] [math [number ["n" nat] ["f" frac] ["[0]" int] - ["[0]" rev ("[1]#[0]" interval)] + ["[0]" rev (.open: "[1]#[0]" interval)] ["[0]" i64]]] [type [primitive (.except)]]]]) diff --git a/stdlib/source/library/lux/data/format/binary.lux b/stdlib/source/library/lux/data/format/binary.lux index 860448136..c1c4707cc 100644 --- a/stdlib/source/library/lux/data/format/binary.lux +++ b/stdlib/source/library/lux/data/format/binary.lux @@ -9,7 +9,7 @@ [control ["[0]" pipe] ["[0]" function] - ["<>" parser ("[1]#[0]" monad) + ["<>" parser (.open: "[1]#[0]" monad) ["</>" binary (.only Offset Size Parser)]]] [data ["/" binary @@ -21,7 +21,7 @@ ["[0]" utf8]]] [collection ["[0]" list] - ["[0]" sequence (.only Sequence) ("[1]#[0]" functor)] + ["[0]" sequence (.only Sequence) (.open: "[1]#[0]" functor)] ["[0]" set (.only Set)] [array [\\unsafe (.only)]]]] diff --git a/stdlib/source/library/lux/data/format/css.lux b/stdlib/source/library/lux/data/format/css.lux index ee8b19f0c..093cc785f 100644 --- a/stdlib/source/library/lux/data/format/css.lux +++ b/stdlib/source/library/lux/data/format/css.lux @@ -8,7 +8,7 @@ ["%" format (.only format)] ["[0]" encoding (.only Encoding)]] [collection - ["[0]" list ("[1]#[0]" functor)]]] + ["[0]" list (.open: "[1]#[0]" functor)]]] [math [number ["[0]" nat]]] diff --git a/stdlib/source/library/lux/data/format/css/class.lux b/stdlib/source/library/lux/data/format/css/class.lux index 5bb68fb2e..6a9ab5e90 100644 --- a/stdlib/source/library/lux/data/format/css/class.lux +++ b/stdlib/source/library/lux/data/format/css/class.lux @@ -5,7 +5,7 @@ [abstract [monad (.only do)]] [data - ["[0]" text ("[1]#[0]" hash) + ["[0]" text (.open: "[1]#[0]" hash) ["%" format (.only format)]]] [macro [syntax (.only syntax:)] diff --git a/stdlib/source/library/lux/data/format/css/id.lux b/stdlib/source/library/lux/data/format/css/id.lux index bc11c304d..5de67ed56 100644 --- a/stdlib/source/library/lux/data/format/css/id.lux +++ b/stdlib/source/library/lux/data/format/css/id.lux @@ -5,7 +5,7 @@ [abstract [monad (.only do)]] [data - ["[0]" text ("[1]#[0]" hash) + ["[0]" text (.open: "[1]#[0]" hash) ["%" format (.only format)]]] [macro [syntax (.only syntax:)] diff --git a/stdlib/source/library/lux/data/format/css/style.lux b/stdlib/source/library/lux/data/format/css/style.lux index 291d13dd8..4b1f26590 100644 --- a/stdlib/source/library/lux/data/format/css/style.lux +++ b/stdlib/source/library/lux/data/format/css/style.lux @@ -5,7 +5,7 @@ [text ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" mix)]]] + ["[0]" list (.open: "[1]#[0]" mix)]]] [type [primitive (.except)]]]] ["[0]" // diff --git a/stdlib/source/library/lux/data/format/css/value.lux b/stdlib/source/library/lux/data/format/css/value.lux index 36ee8de22..07369e1dc 100644 --- a/stdlib/source/library/lux/data/format/css/value.lux +++ b/stdlib/source/library/lux/data/format/css/value.lux @@ -11,7 +11,7 @@ ["[0]" text ["%" format (.only Format format)]] [collection - ["[0]" list ("[1]#[0]" functor)]]] + ["[0]" list (.open: "[1]#[0]" functor)]]] [macro [syntax (.only syntax:)] ["[0]" template] diff --git a/stdlib/source/library/lux/data/format/html.lux b/stdlib/source/library/lux/data/format/html.lux index d42afc3c4..44ff23595 100644 --- a/stdlib/source/library/lux/data/format/html.lux +++ b/stdlib/source/library/lux/data/format/html.lux @@ -3,13 +3,13 @@ [lux (.except Meta Source comment and template) [control ["[0]" function] - ["[0]" maybe ("[1]#[0]" functor)]] + ["[0]" maybe (.open: "[1]#[0]" functor)]] [data ["[0]" product] ["[0]" text ["%" format (.only Format format)]] [collection - ["[0]" list ("[1]#[0]" functor mix)]]] + ["[0]" list (.open: "[1]#[0]" functor mix)]]] [macro ["[0]" template]] [target diff --git a/stdlib/source/library/lux/data/format/json.lux b/stdlib/source/library/lux/data/format/json.lux index c2f8d2ef1..14127b8ef 100644 --- a/stdlib/source/library/lux/data/format/json.lux +++ b/stdlib/source/library/lux/data/format/json.lux @@ -11,16 +11,16 @@ ["[0]" pipe] ["[0]" maybe] ["[0]" try (.only Try)] - ["<>" parser ("[1]#[0]" monad) + ["<>" parser (.open: "[1]#[0]" monad) ["<[0]>" text (.only Parser)] ["<[0]>" code]]] [data ["[0]" bit] ["[0]" product] - ["[0]" text ("[1]#[0]" equivalence monoid)] + ["[0]" text (.open: "[1]#[0]" equivalence monoid)] [collection - ["[0]" list ("[1]#[0]" mix functor)] - ["[0]" sequence (.only Sequence sequence) ("[1]#[0]" monad)] + ["[0]" list (.open: "[1]#[0]" mix functor)] + ["[0]" sequence (.only Sequence sequence) (.open: "[1]#[0]" monad)] ["[0]" dictionary (.only Dictionary)]]] [macro [syntax (.only syntax:)] @@ -29,7 +29,7 @@ [math [number ["n" nat] - ["f" frac ("[1]#[0]" decimal)]]]]]) + ["f" frac (.open: "[1]#[0]" decimal)]]]]]) (template [<name> <type>] [(type: .public <name> diff --git a/stdlib/source/library/lux/data/format/markdown.lux b/stdlib/source/library/lux/data/format/markdown.lux index db33dd5ab..4982a2b63 100644 --- a/stdlib/source/library/lux/data/format/markdown.lux +++ b/stdlib/source/library/lux/data/format/markdown.lux @@ -5,7 +5,7 @@ ["[0]" text (.only) ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" functor)]]] + ["[0]" list (.open: "[1]#[0]" functor)]]] [type [primitive (.except)]] [world diff --git a/stdlib/source/library/lux/data/format/tar.lux b/stdlib/source/library/lux/data/format/tar.lux index e671de780..9dd84b4e8 100644 --- a/stdlib/source/library/lux/data/format/tar.lux +++ b/stdlib/source/library/lux/data/format/tar.lux @@ -19,10 +19,10 @@ [encoding ["[0]" utf8]]] ["[0]" format - ["[1]" binary (.only Writer) ("[1]#[0]" monoid)]] + ["[1]" binary (.only Writer) (.open: "[1]#[0]" monoid)]] [collection - ["[0]" list ("[1]#[0]" mix)] - ["[0]" sequence (.only Sequence) ("[1]#[0]" mix)] + ["[0]" list (.open: "[1]#[0]" mix)] + ["[0]" sequence (.only Sequence) (.open: "[1]#[0]" mix)] [array [\\unsafe (.only)]]]] [macro diff --git a/stdlib/source/library/lux/data/format/xml.lux b/stdlib/source/library/lux/data/format/xml.lux index b7877bdbe..89a8eccad 100644 --- a/stdlib/source/library/lux/data/format/xml.lux +++ b/stdlib/source/library/lux/data/format/xml.lux @@ -7,20 +7,20 @@ [codec (.only Codec)]] [control [try (.only Try)] - ["<>" parser ("[1]#[0]" monad) + ["<>" parser (.open: "[1]#[0]" monad) ["<[0]>" text (.only Parser Slice)]]] [data ["[0]" product] - ["[0]" text (.only \n) ("[1]#[0]" equivalence monoid)] + ["[0]" text (.only \n) (.open: "[1]#[0]" equivalence monoid)] [collection - ["[0]" list ("[1]#[0]" functor)] + ["[0]" list (.open: "[1]#[0]" functor)] ["[0]" dictionary (.only Dictionary)]]] [math [number ["n" nat] ["[0]" int]]] [meta - ["[0]" symbol ("[1]#[0]" equivalence codec)]]]]) + ["[0]" symbol (.open: "[1]#[0]" equivalence codec)]]]]) (type: .public Tag Symbol) diff --git a/stdlib/source/library/lux/data/text.lux b/stdlib/source/library/lux/data/text.lux index fde7cd9f8..ecc17837e 100644 --- a/stdlib/source/library/lux/data/text.lux +++ b/stdlib/source/library/lux/data/text.lux @@ -13,7 +13,7 @@ ["[0]" maybe]] [data [collection - ["[0]" list ("[1]#[0]" mix)]]] + ["[0]" list (.open: "[1]#[0]" mix)]]] [macro ["^" pattern]] [math diff --git a/stdlib/source/library/lux/data/text/buffer.lux b/stdlib/source/library/lux/data/text/buffer.lux index a53e60f77..5658dcddb 100644 --- a/stdlib/source/library/lux/data/text/buffer.lux +++ b/stdlib/source/library/lux/data/text/buffer.lux @@ -11,7 +11,7 @@ ["%" format (.only format)]] [collection ["[0]" array] - ["[0]" sequence (.only Sequence) ("[1]#[0]" mix)]]] + ["[0]" sequence (.only Sequence) (.open: "[1]#[0]" mix)]]] [math [number ["n" nat]]] diff --git a/stdlib/source/library/lux/data/text/format.lux b/stdlib/source/library/lux/data/text/format.lux index 87e258477..c6dac322e 100644 --- a/stdlib/source/library/lux/data/text/format.lux +++ b/stdlib/source/library/lux/data/text/format.lux @@ -15,7 +15,7 @@ ["[0]" xml] ["[0]" json]] [collection - ["[0]" list ("[1]#[0]" monad)]]] + ["[0]" list (.open: "[1]#[0]" monad)]]] ["[0]" time (.only) ["[0]" instant] ["[0]" duration] diff --git a/stdlib/source/library/lux/data/text/regex.lux b/stdlib/source/library/lux/data/text/regex.lux index f9e57e97f..af653dbdf 100644 --- a/stdlib/source/library/lux/data/text/regex.lux +++ b/stdlib/source/library/lux/data/text/regex.lux @@ -8,20 +8,20 @@ ["[0]" maybe] ["[0]" try] ["[0]" exception (.only exception:)] - ["<>" parser ("[1]#[0]" monad) + ["<>" parser (.open: "[1]#[0]" monad) ["<[0]>" text (.only Parser)] ["<[0]>" code]]] [data ["[0]" product] [collection - ["[0]" list ("[1]#[0]" mix monad)]]] + ["[0]" list (.open: "[1]#[0]" mix monad)]]] [macro (.only with_symbols) [syntax (.only syntax:)] ["^" pattern] ["[0]" code]] [math [number (.only hex) - ["n" nat ("[1]#[0]" decimal)]]]]] + ["n" nat (.open: "[1]#[0]" decimal)]]]]] ["[0]" // (.only) ["%" format (.only format)]]) diff --git a/stdlib/source/library/lux/data/text/unicode/block.lux b/stdlib/source/library/lux/data/text/unicode/block.lux index f2c315dfa..45729b8ba 100644 --- a/stdlib/source/library/lux/data/text/unicode/block.lux +++ b/stdlib/source/library/lux/data/text/unicode/block.lux @@ -8,7 +8,7 @@ ["[0]" interval (.only Interval)]] [math [number (.only hex) - ["n" nat ("[1]#[0]" interval)] + ["n" nat (.open: "[1]#[0]" interval)] ["[0]" i64]]] [type [primitive (.except)]]]] diff --git a/stdlib/source/library/lux/data/text/unicode/set.lux b/stdlib/source/library/lux/data/text/unicode/set.lux index aa166bb5b..58730c36f 100644 --- a/stdlib/source/library/lux/data/text/unicode/set.lux +++ b/stdlib/source/library/lux/data/text/unicode/set.lux @@ -5,8 +5,8 @@ [equivalence (.only Equivalence)]] [data [collection - ["[0]" list ("[1]#[0]" mix functor)] - ["[0]" set ("[1]#[0]" equivalence)] + ["[0]" list (.open: "[1]#[0]" mix functor)] + ["[0]" set (.open: "[1]#[0]" equivalence)] ["[0]" tree ["[1]" finger (.only Tree)]]]] [type (.only by_example) diff --git a/stdlib/source/library/lux/debug.lux b/stdlib/source/library/lux/debug.lux index 3ec9155fa..765cb6079 100644 --- a/stdlib/source/library/lux/debug.lux +++ b/stdlib/source/library/lux/debug.lux @@ -23,7 +23,7 @@ ["[0]" json]] [collection ["[0]" array] - ["[0]" list ("[1]#[0]" monad)] + ["[0]" list (.open: "[1]#[0]" monad)] ["[0]" dictionary]]] [macro ["^" pattern] diff --git a/stdlib/source/library/lux/documentation.lux b/stdlib/source/library/lux/documentation.lux index f39019bfd..f71f812df 100644 --- a/stdlib/source/library/lux/documentation.lux +++ b/stdlib/source/library/lux/documentation.lux @@ -2,21 +2,21 @@ [library [lux (.except Definition Module type) ["[0]" meta] - ["[0]" type ("[1]#[0]" equivalence)] + ["[0]" type (.open: "[1]#[0]" equivalence)] [abstract [monad (.only do)] ["[0]" enum]] [control - ["[0]" maybe ("[1]#[0]" functor)] + ["[0]" maybe (.open: "[1]#[0]" functor)] ["[0]" exception (.only exception:)] - ["<>" parser ("[1]#[0]" monad) + ["<>" parser (.open: "[1]#[0]" monad) ["<[0]>" code (.only Parser)]]] [data ["[0]" product] - ["[0]" text (.only \n) ("[1]#[0]" order) + ["[0]" text (.only \n) (.open: "[1]#[0]" order) ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" monad mix monoid)] + ["[0]" list (.open: "[1]#[0]" monad mix monoid)] ["[0]" set (.only Set)] ["[0]" stream (.only Stream)]] [format diff --git a/stdlib/source/library/lux/extension.lux b/stdlib/source/library/lux/extension.lux index 5a61520e6..4ad6c5592 100644 --- a/stdlib/source/library/lux/extension.lux +++ b/stdlib/source/library/lux/extension.lux @@ -4,14 +4,14 @@ [abstract ["[0]" monad]] [control - ["<>" parser ("[1]#[0]" monad) + ["<>" parser (.open: "[1]#[0]" monad) ["<c>" code (.only Parser)] ["<a>" analysis] ["<s>" synthesis]]] [data ["[0]" product] [collection - ["[0]" list ("[1]#[0]" functor)]]] + ["[0]" list (.open: "[1]#[0]" functor)]]] [macro (.only with_symbols) [syntax (.only syntax:)] ["[0]" code]] diff --git a/stdlib/source/library/lux/ffi.jvm.lux b/stdlib/source/library/lux/ffi.jvm.lux index 5d53095cf..6f22bfb29 100644 --- a/stdlib/source/library/lux/ffi.jvm.lux +++ b/stdlib/source/library/lux/ffi.jvm.lux @@ -9,15 +9,15 @@ ["[0]" maybe] ["[0]" try (.only Try)] ["[0]" exception (.only Exception exception:)] - ["<>" parser ("[1]#[0]" monad) + ["<>" parser (.open: "[1]#[0]" monad) ["<[0]>" code (.only Parser)]]] [data ["[0]" product] - ["[0]" text ("[1]#[0]" equivalence) + ["[0]" text (.open: "[1]#[0]" equivalence) ["%" format (.only format)]] [collection ["[0]" array] - ["[0]" list ("[1]#[0]" monad mix monoid)] + ["[0]" list (.open: "[1]#[0]" monad mix monoid)] ["[0]" dictionary (.only Dictionary)]]] [macro (.only with_symbols) [syntax (.only syntax:)] @@ -35,7 +35,7 @@ ["[0]" signature] ["[0]" reflection] ["[0]" parser]]]] - ["[0]" type ("[1]#[0]" equivalence) + ["[0]" type (.open: "[1]#[0]" equivalence) ["[0]" check]]]]) (def: internal diff --git a/stdlib/source/library/lux/ffi.lux b/stdlib/source/library/lux/ffi.lux index ca7616417..2ad70d784 100644 --- a/stdlib/source/library/lux/ffi.lux +++ b/stdlib/source/library/lux/ffi.lux @@ -7,15 +7,15 @@ [monad (.only do)]] [control ["[0]" io] - ["[0]" maybe ("[1]#[0]" functor)] - ["<>" parser ("[1]#[0]" monad) + ["[0]" maybe (.open: "[1]#[0]" functor)] + ["<>" parser (.open: "[1]#[0]" monad) ["<[0]>" code (.only Parser)]]] [data ["[0]" product] - ["[0]" text ("[1]#[0]" equivalence) + ["[0]" text (.open: "[1]#[0]" equivalence) ["%" format]] [collection - ["[0]" list ("[1]#[0]" monad mix)]]] + ["[0]" list (.open: "[1]#[0]" monad mix)]]] ["[0]" macro (.only with_symbols) [syntax (.only syntax:)] ["[0]" code] diff --git a/stdlib/source/library/lux/ffi.old.lux b/stdlib/source/library/lux/ffi.old.lux index 19f5b8a9f..596d588e2 100644 --- a/stdlib/source/library/lux/ffi.old.lux +++ b/stdlib/source/library/lux/ffi.old.lux @@ -1,7 +1,7 @@ (.using [library [lux (.except is as type) - ["[0]" type ("[1]#[0]" equivalence)] + ["[0]" type (.open: "[1]#[0]" equivalence)] [abstract ["[0]" monad (.only Monad do)] ["[0]" enum]] @@ -14,12 +14,12 @@ ["<[0]>" code (.only Parser)]]] [data ["[0]" product] - ["[0]" bit ("[1]#[0]" codec)] - ["[0]" text ("[1]#[0]" equivalence monoid) + ["[0]" bit (.open: "[1]#[0]" codec)] + ["[0]" text (.open: "[1]#[0]" equivalence monoid) ["%" format (.only format)]] [collection ["[0]" array (.only Array)] - ["[0]" list ("[1]#[0]" monad mix monoid)]]] + ["[0]" list (.open: "[1]#[0]" monad mix monoid)]]] ["[0]" macro (.only with_symbols) [syntax (.only syntax:)] ["^" pattern] diff --git a/stdlib/source/library/lux/ffi.php.lux b/stdlib/source/library/lux/ffi.php.lux index 2bfb31b5d..2f7350849 100644 --- a/stdlib/source/library/lux/ffi.php.lux +++ b/stdlib/source/library/lux/ffi.php.lux @@ -8,14 +8,14 @@ [control ["[0]" io] ["[0]" maybe] - ["<>" parser ("[1]#[0]" monad) + ["<>" parser (.open: "[1]#[0]" monad) ["<[0]>" code (.only Parser)]]] [data ["[0]" product] ["[0]" text ["%" format]] [collection - ["[0]" list ("[1]#[0]" functor)]]] + ["[0]" list (.open: "[1]#[0]" functor)]]] [type abstract] [macro (.only with_symbols) diff --git a/stdlib/source/library/lux/ffi.scm.lux b/stdlib/source/library/lux/ffi.scm.lux index 0cf11daab..6903adb4c 100644 --- a/stdlib/source/library/lux/ffi.scm.lux +++ b/stdlib/source/library/lux/ffi.scm.lux @@ -8,14 +8,14 @@ [control ["[0]" io] ["[0]" maybe] - ["<>" parser ("[1]#[0]" monad) + ["<>" parser (.open: "[1]#[0]" monad) ["<[0]>" code (.only Parser)]]] [data ["[0]" product] ["[0]" text ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" functor)]]] + ["[0]" list (.open: "[1]#[0]" functor)]]] [type abstract] [macro (.only with_symbols) diff --git a/stdlib/source/library/lux/ffi/export.js.lux b/stdlib/source/library/lux/ffi/export.js.lux index e93309e39..ac23e6b6b 100644 --- a/stdlib/source/library/lux/ffi/export.js.lux +++ b/stdlib/source/library/lux/ffi/export.js.lux @@ -13,7 +13,7 @@ [text ["%" format]] [collection - ["[0]" list ("[1]#[0]" monad mix)] + ["[0]" list (.open: "[1]#[0]" monad mix)] ["[0]" set]]] ["[0]" macro (.only) [syntax (.only syntax:)] diff --git a/stdlib/source/library/lux/ffi/export.jvm.lux b/stdlib/source/library/lux/ffi/export.jvm.lux index 17750a864..fea7a2239 100644 --- a/stdlib/source/library/lux/ffi/export.jvm.lux +++ b/stdlib/source/library/lux/ffi/export.jvm.lux @@ -6,7 +6,7 @@ ["<[0]>" code (.only Parser)]]] [data [collection - ["[0]" list ("[1]#[0]" monad)]]] + ["[0]" list (.open: "[1]#[0]" monad)]]] [macro [syntax (.only syntax:)] ["[0]" code]]]] diff --git a/stdlib/source/library/lux/ffi/export.lua.lux b/stdlib/source/library/lux/ffi/export.lua.lux index f4c6fc8d8..adcb632ab 100644 --- a/stdlib/source/library/lux/ffi/export.lua.lux +++ b/stdlib/source/library/lux/ffi/export.lua.lux @@ -13,7 +13,7 @@ [text ["%" format]] [collection - ["[0]" list ("[1]#[0]" monad mix)] + ["[0]" list (.open: "[1]#[0]" monad mix)] ["[0]" set]]] ["[0]" macro (.only) [syntax (.only syntax:)] diff --git a/stdlib/source/library/lux/ffi/export.py.lux b/stdlib/source/library/lux/ffi/export.py.lux index 98399e34b..b9abc8a7a 100644 --- a/stdlib/source/library/lux/ffi/export.py.lux +++ b/stdlib/source/library/lux/ffi/export.py.lux @@ -13,7 +13,7 @@ [text ["%" format]] [collection - ["[0]" list ("[1]#[0]" monad mix)] + ["[0]" list (.open: "[1]#[0]" monad mix)] ["[0]" set]]] ["[0]" macro (.only) [syntax (.only syntax:)] diff --git a/stdlib/source/library/lux/ffi/export.rb.lux b/stdlib/source/library/lux/ffi/export.rb.lux index e82fcbdb2..b23a85dc7 100644 --- a/stdlib/source/library/lux/ffi/export.rb.lux +++ b/stdlib/source/library/lux/ffi/export.rb.lux @@ -15,7 +15,7 @@ [text ["%" format]] [collection - ["[0]" list ("[1]#[0]" monad mix)] + ["[0]" list (.open: "[1]#[0]" monad mix)] ["[0]" set]]] ["[0]" macro (.only) [syntax (.only syntax:)] diff --git a/stdlib/source/library/lux/ffi/node_js.js.lux b/stdlib/source/library/lux/ffi/node_js.js.lux index 60186306a..a31054f74 100644 --- a/stdlib/source/library/lux/ffi/node_js.js.lux +++ b/stdlib/source/library/lux/ffi/node_js.js.lux @@ -4,7 +4,7 @@ ["[0]" ffi] [control ["[0]" function] - ["[0]" maybe ("[1]#[0]" monoid functor)]]]]) + ["[0]" maybe (.open: "[1]#[0]" monoid functor)]]]]) (template [<name> <path>] [(def: <name> diff --git a/stdlib/source/library/lux/locale.lux b/stdlib/source/library/lux/locale.lux index 63fc6f06f..0d5117c48 100644 --- a/stdlib/source/library/lux/locale.lux +++ b/stdlib/source/library/lux/locale.lux @@ -5,7 +5,7 @@ [equivalence (.only Equivalence)] ["[0]" hash (.only Hash)]] [control - ["[0]" maybe ("[1]#[0]" functor)]] + ["[0]" maybe (.open: "[1]#[0]" functor)]] [data ["[0]" text (.only) ["%" format (.only format)] diff --git a/stdlib/source/library/lux/macro.lux b/stdlib/source/library/lux/macro.lux index d9a68d76e..e455b55f4 100644 --- a/stdlib/source/library/lux/macro.lux +++ b/stdlib/source/library/lux/macro.lux @@ -4,9 +4,9 @@ [abstract ["[0]" monad (.only do)]] [data - ["[0]" text ("[1]#[0]" monoid)] + ["[0]" text (.open: "[1]#[0]" monoid)] [collection - ["[0]" list ("[1]#[0]" monoid monad)]]] + ["[0]" list (.open: "[1]#[0]" monoid monad)]]] [math [number ["[0]" nat] @@ -16,7 +16,7 @@ ["[0]" // ["[1]" meta (.only) ["[0]" location] - ["[0]" symbol ("[1]#[0]" codec)]]]]) + ["[0]" symbol (.open: "[1]#[0]" codec)]]]]) (def: .public (single_expansion syntax) (-> Code (Meta (List Code))) diff --git a/stdlib/source/library/lux/macro/code.lux b/stdlib/source/library/lux/macro/code.lux index 2d670c70c..74cab5a40 100644 --- a/stdlib/source/library/lux/macro/code.lux +++ b/stdlib/source/library/lux/macro/code.lux @@ -6,9 +6,9 @@ [data ["[0]" product] ["[0]" bit] - ["[0]" text ("[1]#[0]" monoid equivalence)] + ["[0]" text (.open: "[1]#[0]" monoid equivalence)] [collection - ["[0]" list ("[1]#[0]" functor mix)]]] + ["[0]" list (.open: "[1]#[0]" functor mix)]]] [macro ["^" pattern]] [math diff --git a/stdlib/source/library/lux/macro/local.lux b/stdlib/source/library/lux/macro/local.lux index 9a317fc6f..b564df336 100644 --- a/stdlib/source/library/lux/macro/local.lux +++ b/stdlib/source/library/lux/macro/local.lux @@ -11,7 +11,7 @@ ["[0]" product] ["[0]" text] [collection - ["[0]" list ("[1]#[0]" functor)] + ["[0]" list (.open: "[1]#[0]" functor)] [dictionary ["[0]" plist (.only PList)]]]]]] ["[0]" // (.only) diff --git a/stdlib/source/library/lux/macro/syntax.lux b/stdlib/source/library/lux/macro/syntax.lux index 5945290d8..baec61e09 100644 --- a/stdlib/source/library/lux/macro/syntax.lux +++ b/stdlib/source/library/lux/macro/syntax.lux @@ -10,7 +10,7 @@ ["<>" parser (.only) ["</>" code (.only Parser)]]] [data - ["[0]" text ("[1]#[0]" monoid)] + ["[0]" text (.open: "[1]#[0]" monoid)] [collection ["[0]" list]]] [math diff --git a/stdlib/source/library/lux/macro/syntax/declaration.lux b/stdlib/source/library/lux/macro/syntax/declaration.lux index aef62c056..b0c23e135 100644 --- a/stdlib/source/library/lux/macro/syntax/declaration.lux +++ b/stdlib/source/library/lux/macro/syntax/declaration.lux @@ -4,13 +4,13 @@ [abstract [equivalence (.only Equivalence)]] [control - ["<>" parser ("[1]#[0]" monad) + ["<>" parser (.open: "[1]#[0]" monad) ["<[0]>" code (.only Parser)]]] [data ["[0]" product] ["[0]" text] [collection - ["[0]" list ("[1]#[0]" functor)]]] + ["[0]" list (.open: "[1]#[0]" functor)]]] [macro ["[0]" code]]]]) diff --git a/stdlib/source/library/lux/macro/syntax/input.lux b/stdlib/source/library/lux/macro/syntax/input.lux index 25d3db6fc..bdac8cad3 100644 --- a/stdlib/source/library/lux/macro/syntax/input.lux +++ b/stdlib/source/library/lux/macro/syntax/input.lux @@ -9,7 +9,7 @@ [data ["[0]" product] [collection - ["[0]" list ("[1]#[0]" monad)]]] + ["[0]" list (.open: "[1]#[0]" monad)]]] [macro ["[0]" code]]]]) diff --git a/stdlib/source/library/lux/macro/template.lux b/stdlib/source/library/lux/macro/template.lux index dc3ef5884..6f4124596 100644 --- a/stdlib/source/library/lux/macro/template.lux +++ b/stdlib/source/library/lux/macro/template.lux @@ -7,22 +7,22 @@ [control ["[0]" try (.only Try)] ["[0]" exception (.only exception:)] - ["<>" parser ("[1]#[0]" functor) + ["<>" parser (.open: "[1]#[0]" functor) ["<[0]>" code (.only Parser)]]] [data - ["[0]" bit ("[1]#[0]" codec)] + ["[0]" bit (.open: "[1]#[0]" codec)] ["[0]" text] [collection - ["[0]" list ("[1]#[0]" monad)] + ["[0]" list (.open: "[1]#[0]" monad)] ["[0]" dictionary (.only Dictionary)]]] [macro ["^" pattern]] [math [number - ["[0]" nat ("[1]#[0]" decimal)] - ["[0]" int ("[1]#[0]" decimal)] - ["[0]" rev ("[1]#[0]" decimal)] - ["[0]" frac ("[1]#[0]" decimal)]]]]] + ["[0]" nat (.open: "[1]#[0]" decimal)] + ["[0]" int (.open: "[1]#[0]" decimal)] + ["[0]" rev (.open: "[1]#[0]" decimal)] + ["[0]" frac (.open: "[1]#[0]" decimal)]]]]] ["[0]" // (.only) [syntax (.only syntax:)] ["[0]" code] diff --git a/stdlib/source/library/lux/math.lux b/stdlib/source/library/lux/math.lux index eaffa1d8a..0a32f20b8 100644 --- a/stdlib/source/library/lux/math.lux +++ b/stdlib/source/library/lux/math.lux @@ -15,13 +15,13 @@ [text ["%" format]] [collection - ["[0]" list ("[1]#[0]" mix)]]] + ["[0]" list (.open: "[1]#[0]" mix)]]] [macro [syntax (.only syntax:)] ["[0]" template]] [tool [compiler - ["[0]" phase ("[1]#[0]" monad)] + ["[0]" phase (.open: "[1]#[0]" monad)] [language [lux ["[0]" analysis (.only Analysis Operation Phase) diff --git a/stdlib/source/library/lux/math/infix.lux b/stdlib/source/library/lux/math/infix.lux index 207d38d54..8a37aa0f7 100644 --- a/stdlib/source/library/lux/math/infix.lux +++ b/stdlib/source/library/lux/math/infix.lux @@ -4,12 +4,12 @@ [abstract [monad (.only do)]] [control - ["<>" parser ("[1]#[0]" functor) + ["<>" parser (.open: "[1]#[0]" functor) ["<[0]>" code (.only Parser)]]] [data ["[0]" product] [collection - ["[0]" list ("[1]#[0]" mix)]]] + ["[0]" list (.open: "[1]#[0]" mix)]]] [macro [syntax (.only syntax:)] ["[0]" code]] diff --git a/stdlib/source/library/lux/math/logic/continuous.lux b/stdlib/source/library/lux/math/logic/continuous.lux index 6640d1668..eec2d573f 100644 --- a/stdlib/source/library/lux/math/logic/continuous.lux +++ b/stdlib/source/library/lux/math/logic/continuous.lux @@ -6,7 +6,7 @@ [monoid (.only Monoid)]] [math [number - ["/" rev ("[1]#[0]" interval)]]]]]) + ["/" rev (.open: "[1]#[0]" interval)]]]]]) (def: .public false Rev /#bottom) (def: .public true Rev /#top) diff --git a/stdlib/source/library/lux/math/modular.lux b/stdlib/source/library/lux/math/modular.lux index e0886c02d..77f611732 100644 --- a/stdlib/source/library/lux/math/modular.lux +++ b/stdlib/source/library/lux/math/modular.lux @@ -15,13 +15,13 @@ ["<[0]>" code]]] [data ["[0]" product] - ["[0]" text ("[1]#[0]" monoid)]] + ["[0]" text (.open: "[1]#[0]" monoid)]] [macro [syntax (.only syntax:)] ["[0]" code]] [math [number - ["i" int ("[1]#[0]" decimal)]]] + ["i" int (.open: "[1]#[0]" decimal)]]] [type [primitive (.except)]]]] ["[0]" // diff --git a/stdlib/source/library/lux/math/number/complex.lux b/stdlib/source/library/lux/math/number/complex.lux index 7b341edf3..5e320c560 100644 --- a/stdlib/source/library/lux/math/number/complex.lux +++ b/stdlib/source/library/lux/math/number/complex.lux @@ -9,7 +9,7 @@ ["<[0]>" code]]] [data [collection - ["[0]" list ("[1]#[0]" functor)]]] + ["[0]" list (.open: "[1]#[0]" functor)]]] [macro [syntax (.only syntax:)]] [math diff --git a/stdlib/source/library/lux/math/number/ratio.lux b/stdlib/source/library/lux/math/number/ratio.lux index b7072395b..a7c1c4762 100644 --- a/stdlib/source/library/lux/math/number/ratio.lux +++ b/stdlib/source/library/lux/math/number/ratio.lux @@ -15,12 +15,12 @@ ["<[0]>" code (.only Parser)]]] [data ["[0]" product] - ["[0]" text ("[1]#[0]" monoid)]] + ["[0]" text (.open: "[1]#[0]" monoid)]] [macro [syntax (.only syntax:)] ["[0]" code]]]] [// - ["n" nat ("[1]#[0]" decimal)]]) + ["n" nat (.open: "[1]#[0]" decimal)]]) (type: .public Ratio (Record diff --git a/stdlib/source/library/lux/math/random.lux b/stdlib/source/library/lux/math/random.lux index 13762f8ec..d60ba29bc 100644 --- a/stdlib/source/library/lux/math/random.lux +++ b/stdlib/source/library/lux/math/random.lux @@ -7,11 +7,11 @@ [apply (.only Apply)] ["[0]" monad (.only Monad do)]] [data - ["[0]" text (.only Char) ("[1]#[0]" monoid) + ["[0]" text (.only Char) (.open: "[1]#[0]" monoid) ["[0]" unicode ["[1]" set]]] [collection - ["[0]" list ("[1]#[0]" mix)] + ["[0]" list (.open: "[1]#[0]" mix)] ["[0]" array (.only Array)] ["[0]" dictionary (.only Dictionary)] ["[0]" queue (.only Queue)] diff --git a/stdlib/source/library/lux/meta.lux b/stdlib/source/library/lux/meta.lux index ef6b283f0..7ceec5bcd 100644 --- a/stdlib/source/library/lux/meta.lux +++ b/stdlib/source/library/lux/meta.lux @@ -10,9 +10,9 @@ ["[0]" try (.only Try)]] [data ["[0]" product] - ["[0]" text ("[1]#[0]" monoid order)] + ["[0]" text (.open: "[1]#[0]" monoid order)] [collection - ["[0]" list ("[1]#[0]" monoid monad)] + ["[0]" list (.open: "[1]#[0]" monoid monad)] [dictionary ["[0]" plist]]]] [macro @@ -23,7 +23,7 @@ ["n" nat] ["i" int]]] [meta - ["[0]" symbol ("[1]#[0]" codec equivalence)]]]] + ["[0]" symbol (.open: "[1]#[0]" codec equivalence)]]]] [/ ["[0]" location]]) diff --git a/stdlib/source/library/lux/meta/configuration.lux b/stdlib/source/library/lux/meta/configuration.lux index 7271f5430..be16a5110 100644 --- a/stdlib/source/library/lux/meta/configuration.lux +++ b/stdlib/source/library/lux/meta/configuration.lux @@ -7,16 +7,16 @@ [monoid (.only Monoid)] [monad (.only do)]] [control - ["[0]" maybe ("[1]#[0]" functor)] + ["[0]" maybe (.open: "[1]#[0]" functor)] ["[0]" exception (.only exception:)] ["<>" parser (.only) ["<[0]>" text (.only Parser)] ["<[0]>" code]]] [data - ["[0]" text ("[1]#[0]" equivalence) + ["[0]" text (.open: "[1]#[0]" equivalence) ["%" format]] [collection - ["[0]" list ("[1]#[0]" functor mix)] + ["[0]" list (.open: "[1]#[0]" functor mix)] [dictionary ["/" plist]]]] [macro diff --git a/stdlib/source/library/lux/meta/symbol.lux b/stdlib/source/library/lux/meta/symbol.lux index 885db4402..b5819f76a 100644 --- a/stdlib/source/library/lux/meta/symbol.lux +++ b/stdlib/source/library/lux/meta/symbol.lux @@ -7,7 +7,7 @@ [order (.only Order)] [codec (.only Codec)]] [data - ["[0]" text ("[1]#[0]" equivalence monoid)] + ["[0]" text (.open: "[1]#[0]" equivalence monoid)] ["[0]" product]]]]) ... (type: Symbol diff --git a/stdlib/source/library/lux/meta/version.lux b/stdlib/source/library/lux/meta/version.lux index 9987d55c1..47bc430b4 100644 --- a/stdlib/source/library/lux/meta/version.lux +++ b/stdlib/source/library/lux/meta/version.lux @@ -9,9 +9,9 @@ ["<>" parser (.only) ["<[0]>" code]]] [data - ["[0]" text ("[1]#[0]" equivalence)] + ["[0]" text (.open: "[1]#[0]" equivalence)] [collection - ["[0]" list ("[1]#[0]" mix)]]] + ["[0]" list (.open: "[1]#[0]" mix)]]] [macro [syntax (.only syntax:)] ["[0]" code]] diff --git a/stdlib/source/library/lux/static.lux b/stdlib/source/library/lux/static.lux index 0aec3e8c2..c9d94bd35 100644 --- a/stdlib/source/library/lux/static.lux +++ b/stdlib/source/library/lux/static.lux @@ -1,7 +1,7 @@ (.using [library [lux (.except nat int rev if cond) - ["[0]" meta ("[1]#[0]" functor)] + ["[0]" meta (.open: "[1]#[0]" functor)] [abstract [monad (.only do)]] [control @@ -9,7 +9,7 @@ ["<[0]>" code]]] [data [collection - ["[0]" list ("[1]#[0]" functor mix)]]] + ["[0]" list (.open: "[1]#[0]" functor mix)]]] [macro [syntax (.only syntax:)] ["[0]" code]] diff --git a/stdlib/source/library/lux/target/common_lisp.lux b/stdlib/source/library/lux/target/common_lisp.lux index e2094f53c..ce523f4d4 100644 --- a/stdlib/source/library/lux/target/common_lisp.lux +++ b/stdlib/source/library/lux/target/common_lisp.lux @@ -7,7 +7,7 @@ ["[0]" text ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" monad monoid)]]] + ["[0]" list (.open: "[1]#[0]" monad monoid)]]] [macro ["[0]" template]] [math diff --git a/stdlib/source/library/lux/target/js.lux b/stdlib/source/library/lux/target/js.lux index ecae74ab2..708ba4abe 100644 --- a/stdlib/source/library/lux/target/js.lux +++ b/stdlib/source/library/lux/target/js.lux @@ -7,7 +7,7 @@ ["[0]" text (.only) ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" functor mix)]]] + ["[0]" list (.open: "[1]#[0]" functor mix)]]] [macro ["[0]" template]] [math diff --git a/stdlib/source/library/lux/target/jvm/attribute.lux b/stdlib/source/library/lux/target/jvm/attribute.lux index 522cb9028..4819f19ea 100644 --- a/stdlib/source/library/lux/target/jvm/attribute.lux +++ b/stdlib/source/library/lux/target/jvm/attribute.lux @@ -24,7 +24,7 @@ [encoding ["[1][0]" unsigned (.only U2 U4)]] ["[1][0]" constant (.only UTF8 Class Value) - ["[2][0]" pool (.only Pool Resource) ("[1]#[0]" monad)]]] + ["[2][0]" pool (.only Pool Resource) (.open: "[1]#[0]" monad)]]] ["[0]" / ["[1][0]" constant (.only Constant)] ["[1][0]" code]]) diff --git a/stdlib/source/library/lux/target/jvm/attribute/code.lux b/stdlib/source/library/lux/target/jvm/attribute/code.lux index 10d2bb92d..629fbfad6 100644 --- a/stdlib/source/library/lux/target/jvm/attribute/code.lux +++ b/stdlib/source/library/lux/target/jvm/attribute/code.lux @@ -7,9 +7,9 @@ ["[0]" product] ["[0]" binary (.only Binary)] [format - ["[0]F" binary (.only Writer) ("[1]#[0]" monoid)]] + ["[0]F" binary (.only Writer) (.open: "[1]#[0]" monoid)]] [collection - ["[0]" sequence (.only Sequence) ("[1]#[0]" functor mix)]]] + ["[0]" sequence (.only Sequence) (.open: "[1]#[0]" functor mix)]]] [math [number ["n" nat]]]]] diff --git a/stdlib/source/library/lux/target/jvm/bytecode.lux b/stdlib/source/library/lux/target/jvm/bytecode.lux index 1f00b97c7..4963f5151 100644 --- a/stdlib/source/library/lux/target/jvm/bytecode.lux +++ b/stdlib/source/library/lux/target/jvm/bytecode.lux @@ -10,14 +10,14 @@ ["[0]" writer (.only Writer)] ["[0]" state (.only +State)] ["[0]" maybe] - ["[0]" try (.only Try) ("[1]#[0]" monad)] + ["[0]" try (.only Try) (.open: "[1]#[0]" monad)] ["[0]" exception (.only exception:)]] [data ["[0]" product] [text ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" functor mix)] + ["[0]" list (.open: "[1]#[0]" functor mix)] ["[0]" dictionary (.only Dictionary)] ["[0]" sequence (.only Sequence)]]] [macro @@ -31,7 +31,7 @@ ["[0]" / ["[1][0]" address (.only Address)] ["[1][0]" jump (.only Jump Big_Jump)] - ["_" instruction (.only Primitive_Array_Type Instruction Estimator) ("[1]#[0]" monoid)] + ["_" instruction (.only Primitive_Array_Type Instruction Estimator) (.open: "[1]#[0]" monoid)] ["[1][0]" environment (.only Environment) [limit ["/[0]" registry (.only Register Registry)] diff --git a/stdlib/source/library/lux/target/jvm/bytecode/environment/limit.lux b/stdlib/source/library/lux/target/jvm/bytecode/environment/limit.lux index 05772986f..a1c60d8d2 100644 --- a/stdlib/source/library/lux/target/jvm/bytecode/environment/limit.lux +++ b/stdlib/source/library/lux/target/jvm/bytecode/environment/limit.lux @@ -9,7 +9,7 @@ [data ["[0]" product] ["[0]" format - ["[1]" binary (.only Writer) ("[1]#[0]" monoid)]]] + ["[1]" binary (.only Writer) (.open: "[1]#[0]" monoid)]]] [math [number ["n" nat]]]]] diff --git a/stdlib/source/library/lux/target/jvm/bytecode/environment/limit/registry.lux b/stdlib/source/library/lux/target/jvm/bytecode/environment/limit/registry.lux index 950735dbb..b8ae7a3c3 100644 --- a/stdlib/source/library/lux/target/jvm/bytecode/environment/limit/registry.lux +++ b/stdlib/source/library/lux/target/jvm/bytecode/environment/limit/registry.lux @@ -4,12 +4,12 @@ [abstract ["[0]" equivalence (.only Equivalence)]] [control - ["[0]" try (.only Try) ("[1]#[0]" functor)]] + ["[0]" try (.only Try) (.open: "[1]#[0]" functor)]] [data [format [binary (.only Writer)]] [collection - ["[0]" list ("[1]#[0]" functor mix)]]] + ["[0]" list (.open: "[1]#[0]" functor mix)]]] [math [number ["n" nat]]] diff --git a/stdlib/source/library/lux/target/jvm/class.lux b/stdlib/source/library/lux/target/jvm/class.lux index 3af3c5c7c..6c4531ed5 100644 --- a/stdlib/source/library/lux/target/jvm/class.lux +++ b/stdlib/source/library/lux/target/jvm/class.lux @@ -10,7 +10,7 @@ [data ["[0]" product] [format - ["[0]F" binary (.only Writer) ("[1]#[0]" monoid)]] + ["[0]F" binary (.only Writer) (.open: "[1]#[0]" monoid)]] [collection ["[0]" sequence (.only Sequence)]]]]] ["[0]" // diff --git a/stdlib/source/library/lux/target/jvm/constant.lux b/stdlib/source/library/lux/target/jvm/constant.lux index 3e50f9758..98fb0ba60 100644 --- a/stdlib/source/library/lux/target/jvm/constant.lux +++ b/stdlib/source/library/lux/target/jvm/constant.lux @@ -11,7 +11,7 @@ ["[0]" product] ["[0]" text] [format - ["[0]F" binary (.only Writer) ("[1]#[0]" monoid)]]] + ["[0]F" binary (.only Writer) (.open: "[1]#[0]" monoid)]]] [macro ["^" pattern] ["[0]" template]] diff --git a/stdlib/source/library/lux/target/jvm/constant/pool.lux b/stdlib/source/library/lux/target/jvm/constant/pool.lux index e459f5eec..2d6c1e4e5 100644 --- a/stdlib/source/library/lux/target/jvm/constant/pool.lux +++ b/stdlib/source/library/lux/target/jvm/constant/pool.lux @@ -14,9 +14,9 @@ ["[0]" product] ["[0]" text] ["[0]" format - ["[1]" binary (.only Writer) ("specification#[0]" monoid)]] + ["[1]" binary (.only Writer) (.open: "specification#[0]" monoid)]] [collection - ["[0]" sequence (.only Sequence) ("[1]#[0]" mix)]]] + ["[0]" sequence (.only Sequence) (.open: "[1]#[0]" mix)]]] [math [number ["[0]" int] diff --git a/stdlib/source/library/lux/target/jvm/constant/tag.lux b/stdlib/source/library/lux/target/jvm/constant/tag.lux index e9a0569e0..7a859d75b 100644 --- a/stdlib/source/library/lux/target/jvm/constant/tag.lux +++ b/stdlib/source/library/lux/target/jvm/constant/tag.lux @@ -12,7 +12,7 @@ [primitive (.except)]]]] ["[0]" /// [encoding - ["[1][0]" unsigned (.only U1) ("u1//[0]" equivalence)]]]) + ["[1][0]" unsigned (.only U1) (.open: "u1//[0]" equivalence)]]]) (primitive: .public Tag U1 diff --git a/stdlib/source/library/lux/target/jvm/field.lux b/stdlib/source/library/lux/target/jvm/field.lux index ade45a2f0..1b8407723 100644 --- a/stdlib/source/library/lux/target/jvm/field.lux +++ b/stdlib/source/library/lux/target/jvm/field.lux @@ -7,7 +7,7 @@ [data ["[0]" product] [format - ["[0]F" binary (.only Writer) ("[1]#[0]" monoid)]] + ["[0]F" binary (.only Writer) (.open: "[1]#[0]" monoid)]] [collection ["[0]" sequence (.only Sequence)]]]]] ["[0]" // diff --git a/stdlib/source/library/lux/target/jvm/method.lux b/stdlib/source/library/lux/target/jvm/method.lux index 5fcb74c45..bf2b73cdb 100644 --- a/stdlib/source/library/lux/target/jvm/method.lux +++ b/stdlib/source/library/lux/target/jvm/method.lux @@ -9,7 +9,7 @@ [data ["[0]" product] ["[0]" format - ["[1]" binary (.only Writer) ("[1]#[0]" monoid)]] + ["[1]" binary (.only Writer) (.open: "[1]#[0]" monoid)]] [collection ["[0]" sequence (.only Sequence)]]]]] ["[0]" // diff --git a/stdlib/source/library/lux/target/jvm/reflection.lux b/stdlib/source/library/lux/target/jvm/reflection.lux index cdfe9e9a0..0941e09b1 100644 --- a/stdlib/source/library/lux/target/jvm/reflection.lux +++ b/stdlib/source/library/lux/target/jvm/reflection.lux @@ -6,15 +6,15 @@ [abstract ["[0]" monad (.only do)]] [control - ["[0]" try (.only Try) ("[1]#[0]" functor)] + ["[0]" try (.only Try) (.open: "[1]#[0]" functor)] ["[0]" exception (.only exception:)] [parser ["<t>" text]]] [data - ["[0]" text ("[1]#[0]" equivalence) + ["[0]" text (.open: "[1]#[0]" equivalence) ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" mix functor)] + ["[0]" list (.open: "[1]#[0]" mix functor)] ["[0]" array] ["[0]" dictionary]]] [macro diff --git a/stdlib/source/library/lux/target/jvm/type.lux b/stdlib/source/library/lux/target/jvm/type.lux index cfb14dfa9..21528b3a3 100644 --- a/stdlib/source/library/lux/target/jvm/type.lux +++ b/stdlib/source/library/lux/target/jvm/type.lux @@ -10,7 +10,7 @@ ["[0]" text (.only) ["%" format (.only Format)]] [collection - ["[0]" list ("[1]#[0]" functor)]]] + ["[0]" list (.open: "[1]#[0]" functor)]]] [math [number ["n" nat]]] diff --git a/stdlib/source/library/lux/target/jvm/type/descriptor.lux b/stdlib/source/library/lux/target/jvm/type/descriptor.lux index e8cf0ba6b..7ded981d8 100644 --- a/stdlib/source/library/lux/target/jvm/type/descriptor.lux +++ b/stdlib/source/library/lux/target/jvm/type/descriptor.lux @@ -6,10 +6,10 @@ [control ["[0]" maybe]] [data - ["[0]" text ("[1]#[0]" equivalence) + ["[0]" text (.open: "[1]#[0]" equivalence) ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" functor)]]] + ["[0]" list (.open: "[1]#[0]" functor)]]] [math [number ["n" nat]]] diff --git a/stdlib/source/library/lux/target/jvm/type/lux.lux b/stdlib/source/library/lux/target/jvm/type/lux.lux index 60ca730d2..b63cafeab 100644 --- a/stdlib/source/library/lux/target/jvm/type/lux.lux +++ b/stdlib/source/library/lux/target/jvm/type/lux.lux @@ -6,18 +6,18 @@ [control ["[0]" try] ["[0]" exception (.only exception:)] - ["<>" parser ("[1]#[0]" monad) + ["<>" parser (.open: "[1]#[0]" monad) ["<[0]>" text (.only Parser)]]] [data ["[0]" product] - ["[0]" text ("[1]#[0]" equivalence) + ["[0]" text (.open: "[1]#[0]" equivalence) ["%" format (.only format)]] [collection ["[0]" array] ["[0]" dictionary (.only Dictionary)]]] [type [primitive (.except)] - ["[0]" check (.only Check) ("[1]#[0]" monad)]]]] + ["[0]" check (.only Check) (.open: "[1]#[0]" monad)]]]] ["[0]" // (.only) [category (.only Void Value Return Method Primitive Object Class Array Var Parameter)] ["[1][0]" descriptor] diff --git a/stdlib/source/library/lux/target/jvm/type/parser.lux b/stdlib/source/library/lux/target/jvm/type/parser.lux index 4a0aa756c..a58a6d8d7 100644 --- a/stdlib/source/library/lux/target/jvm/type/parser.lux +++ b/stdlib/source/library/lux/target/jvm/type/parser.lux @@ -6,7 +6,7 @@ [control ["[0]" try] ["[0]" function] - ["<>" parser ("[1]#[0]" monad) + ["<>" parser (.open: "[1]#[0]" monad) ["<[0]>" text (.only Parser)]]] [data ["[0]" product] diff --git a/stdlib/source/library/lux/target/jvm/type/reflection.lux b/stdlib/source/library/lux/target/jvm/type/reflection.lux index e6f51e411..47c5d7d73 100644 --- a/stdlib/source/library/lux/target/jvm/type/reflection.lux +++ b/stdlib/source/library/lux/target/jvm/type/reflection.lux @@ -4,7 +4,7 @@ [abstract [equivalence (.only Equivalence)]] [data - ["[0]" text ("[1]#[0]" equivalence) + ["[0]" text (.open: "[1]#[0]" equivalence) ["%" format (.only format)]]] [type [primitive (.except)]]]] diff --git a/stdlib/source/library/lux/target/jvm/type/signature.lux b/stdlib/source/library/lux/target/jvm/type/signature.lux index ef9d139ea..f66989972 100644 --- a/stdlib/source/library/lux/target/jvm/type/signature.lux +++ b/stdlib/source/library/lux/target/jvm/type/signature.lux @@ -7,10 +7,10 @@ [control ["[0]" pipe]] [data - ["[0]" text ("[1]#[0]" hash) + ["[0]" text (.open: "[1]#[0]" hash) ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" functor)]]] + ["[0]" list (.open: "[1]#[0]" functor)]]] [type [primitive (.except)]]]] ["[0]" // diff --git a/stdlib/source/library/lux/target/lua.lux b/stdlib/source/library/lux/target/lua.lux index e0bed2c3c..f334dbc83 100644 --- a/stdlib/source/library/lux/target/lua.lux +++ b/stdlib/source/library/lux/target/lua.lux @@ -14,7 +14,7 @@ ["[0]" text (.only) ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" functor mix)]]] + ["[0]" list (.open: "[1]#[0]" functor mix)]]] [macro [syntax (.only syntax:)] ["[0]" template] diff --git a/stdlib/source/library/lux/target/php.lux b/stdlib/source/library/lux/target/php.lux index 7b9cec65a..52f872a04 100644 --- a/stdlib/source/library/lux/target/php.lux +++ b/stdlib/source/library/lux/target/php.lux @@ -14,7 +14,7 @@ ["[0]" text (.only) ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" functor mix)]]] + ["[0]" list (.open: "[1]#[0]" functor mix)]]] [macro [syntax (.only syntax:)] ["[0]" template] diff --git a/stdlib/source/library/lux/target/python.lux b/stdlib/source/library/lux/target/python.lux index ae3904333..ae5014d34 100644 --- a/stdlib/source/library/lux/target/python.lux +++ b/stdlib/source/library/lux/target/python.lux @@ -15,7 +15,7 @@ ["[0]" text (.only) ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" functor mix)]]] + ["[0]" list (.open: "[1]#[0]" functor mix)]]] [macro [syntax (.only syntax:)] ["[0]" template] diff --git a/stdlib/source/library/lux/target/r.lux b/stdlib/source/library/lux/target/r.lux index c16e07eac..0d4e813dc 100644 --- a/stdlib/source/library/lux/target/r.lux +++ b/stdlib/source/library/lux/target/r.lux @@ -4,14 +4,14 @@ [control ["[0]" pipe] ["[0]" function] - ["[0]" maybe ("[1]#[0]" functor)] + ["[0]" maybe (.open: "[1]#[0]" functor)] [parser ["<[0]>" code]]] [data ["[0]" text ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" functor mix)]]] + ["[0]" list (.open: "[1]#[0]" functor mix)]]] [macro [syntax (.only syntax:)] ["[0]" template] diff --git a/stdlib/source/library/lux/target/ruby.lux b/stdlib/source/library/lux/target/ruby.lux index a157e513b..356906d27 100644 --- a/stdlib/source/library/lux/target/ruby.lux +++ b/stdlib/source/library/lux/target/ruby.lux @@ -14,7 +14,7 @@ ["[0]" text (.only) ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" functor mix)]]] + ["[0]" list (.open: "[1]#[0]" functor mix)]]] [macro [syntax (.only syntax:)] ["[0]" template] diff --git a/stdlib/source/library/lux/target/scheme.lux b/stdlib/source/library/lux/target/scheme.lux index e3e6fb09b..e77a76d6d 100644 --- a/stdlib/source/library/lux/target/scheme.lux +++ b/stdlib/source/library/lux/target/scheme.lux @@ -11,7 +11,7 @@ ["[0]" text (.only) ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" functor monoid)]]] + ["[0]" list (.open: "[1]#[0]" functor monoid)]]] [macro ["[0]" template]] [math diff --git a/stdlib/source/library/lux/test.lux b/stdlib/source/library/lux/test.lux index e72427137..71c7c1a53 100644 --- a/stdlib/source/library/lux/test.lux +++ b/stdlib/source/library/lux/test.lux @@ -13,7 +13,7 @@ ["[0]" io] [concurrency ["[0]" atom (.only Atom)] - ["[0]" async (.only Async) ("[1]#[0]" monad)]] + ["[0]" async (.only Async) (.open: "[1]#[0]" monad)]] ["<>" parser (.only) ["<[0]>" code]]] [data @@ -21,7 +21,7 @@ ["[0]" text (.only) ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" functor mix)] + ["[0]" list (.open: "[1]#[0]" functor mix)] ["[0]" set (.only Set)] ["[0]" dictionary ["[1]" ordered (.only Dictionary)]]]] @@ -29,7 +29,7 @@ ["[0]" instant] ["[0]" duration (.only Duration)]] [math - ["[0]" random (.only Random) ("[1]#[0]" monad)] + ["[0]" random (.only Random) (.open: "[1]#[0]" monad)] [number (.only hex) ["n" nat] ["f" frac]]] diff --git a/stdlib/source/library/lux/time.lux b/stdlib/source/library/lux/time.lux index 79343f319..d0f07d610 100644 --- a/stdlib/source/library/lux/time.lux +++ b/stdlib/source/library/lux/time.lux @@ -14,10 +14,10 @@ ["<>" parser (.only) ["<[0]>" text (.only Parser)]]] [data - ["[0]" text ("[1]#[0]" monoid)]] + ["[0]" text (.open: "[1]#[0]" monoid)]] [math [number - ["n" nat ("[1]#[0]" decimal)]]] + ["n" nat (.open: "[1]#[0]" decimal)]]] [type [primitive (.except)]]]] [/ diff --git a/stdlib/source/library/lux/time/date.lux b/stdlib/source/library/lux/time/date.lux index 1d0df3aca..3327f15e8 100644 --- a/stdlib/source/library/lux/time/date.lux +++ b/stdlib/source/library/lux/time/date.lux @@ -14,13 +14,13 @@ ["<>" parser (.only) ["<[0]>" text (.only Parser)]]] [data - ["[0]" text ("[1]#[0]" monoid)] + ["[0]" text (.open: "[1]#[0]" monoid)] [collection - ["[0]" list ("[1]#[0]" mix)] + ["[0]" list (.open: "[1]#[0]" mix)] ["[0]" dictionary (.only Dictionary)]]] [math [number - ["n" nat ("[1]#[0]" decimal)] + ["n" nat (.open: "[1]#[0]" decimal)] ["i" int]]] [type [primitive (.except)]]]] diff --git a/stdlib/source/library/lux/time/day.lux b/stdlib/source/library/lux/time/day.lux index 590d850ed..a245c924b 100644 --- a/stdlib/source/library/lux/time/day.lux +++ b/stdlib/source/library/lux/time/day.lux @@ -11,7 +11,7 @@ ["[0]" try (.only Try)] ["[0]" exception (.only exception:)]] [data - ["[0]" text ("[1]#[0]" monoid)]] + ["[0]" text (.open: "[1]#[0]" monoid)]] [macro ["^" pattern] ["[0]" template]] diff --git a/stdlib/source/library/lux/time/duration.lux b/stdlib/source/library/lux/time/duration.lux index 4616890db..75fcddefd 100644 --- a/stdlib/source/library/lux/time/duration.lux +++ b/stdlib/source/library/lux/time/duration.lux @@ -13,11 +13,11 @@ ["<>" parser (.only) ["<[0]>" text (.only Parser)]]] [data - ["[0]" text ("[1]#[0]" monoid)]] + ["[0]" text (.open: "[1]#[0]" monoid)]] [math [number ["i" int] - ["[0]" nat ("[1]#[0]" decimal)]]] + ["[0]" nat (.open: "[1]#[0]" decimal)]]] [type [primitive (.except)]]]] ["[0]" // diff --git a/stdlib/source/library/lux/time/instant.lux b/stdlib/source/library/lux/time/instant.lux index 4d36a5a7d..3a6071f59 100644 --- a/stdlib/source/library/lux/time/instant.lux +++ b/stdlib/source/library/lux/time/instant.lux @@ -16,7 +16,7 @@ ["<>" parser (.only) ["<[0]>" text (.only Parser)]]] [data - ["[0]" text ("[1]#[0]" monoid)]] + ["[0]" text (.open: "[1]#[0]" monoid)]] [math [number ["i" int] diff --git a/stdlib/source/library/lux/time/month.lux b/stdlib/source/library/lux/time/month.lux index 65cc2f570..0b8d8b8a8 100644 --- a/stdlib/source/library/lux/time/month.lux +++ b/stdlib/source/library/lux/time/month.lux @@ -11,7 +11,7 @@ ["[0]" try (.only Try)] ["[0]" exception (.only exception:)]] [data - ["[0]" text ("[1]#[0]" monoid)]] + ["[0]" text (.open: "[1]#[0]" monoid)]] [macro ["^" pattern] ["[0]" template]] diff --git a/stdlib/source/library/lux/time/year.lux b/stdlib/source/library/lux/time/year.lux index aac70a1b3..d10df7456 100644 --- a/stdlib/source/library/lux/time/year.lux +++ b/stdlib/source/library/lux/time/year.lux @@ -12,11 +12,11 @@ ["<>" parser (.only) ["<[0]>" text (.only Parser)]]] [data - ["[0]" text ("[1]#[0]" monoid)]] + ["[0]" text (.open: "[1]#[0]" monoid)]] [math [number - ["n" nat ("[1]#[0]" decimal)] - ["i" int ("[1]#[0]" decimal)]]] + ["n" nat (.open: "[1]#[0]" decimal)] + ["i" int (.open: "[1]#[0]" decimal)]]] [type [primitive (.except)]]]]) diff --git a/stdlib/source/library/lux/tool/compiler/default/init.lux b/stdlib/source/library/lux/tool/compiler/default/init.lux index 1b91c925c..6ddca02cf 100644 --- a/stdlib/source/library/lux/tool/compiler/default/init.lux +++ b/stdlib/source/library/lux/tool/compiler/default/init.lux @@ -11,13 +11,13 @@ [data [binary (.only Binary)] ["[0]" product] - ["[0]" text ("[1]#[0]" hash) + ["[0]" text (.open: "[1]#[0]" hash) ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" functor)] + ["[0]" list (.open: "[1]#[0]" functor)] ["[0]" dictionary] ["[0]" set] - ["[0]" sequence ("[1]#[0]" functor)]]] + ["[0]" sequence (.open: "[1]#[0]" functor)]]] [meta ["[0]" configuration (.only Configuration)] ["[0]" version]] diff --git a/stdlib/source/library/lux/tool/compiler/default/platform.lux b/stdlib/source/library/lux/tool/compiler/default/platform.lux index 72504779c..680a6a759 100644 --- a/stdlib/source/library/lux/tool/compiler/default/platform.lux +++ b/stdlib/source/library/lux/tool/compiler/default/platform.lux @@ -9,22 +9,22 @@ [control ["[0]" function] ["[0]" maybe] - ["[0]" try (.only Try) ("[1]#[0]" monad)] + ["[0]" try (.only Try) (.open: "[1]#[0]" monad)] ["[0]" exception (.only exception:)] [concurrency - ["[0]" async (.only Async Resolver) ("[1]#[0]" monad)] + ["[0]" async (.only Async Resolver) (.open: "[1]#[0]" monad)] ["[0]" stm (.only Var STM)]]] [data ["[0]" binary (.only Binary)] ["[0]" bit] ["[0]" product] - ["[0]" text ("[1]#[0]" equivalence) + ["[0]" text (.open: "[1]#[0]" equivalence) ["%" format (.only format)]] [collection ["[0]" dictionary (.only Dictionary)] - ["[0]" sequence (.only Sequence) ("[1]#[0]" mix)] + ["[0]" sequence (.only Sequence) (.open: "[1]#[0]" mix)] ["[0]" set (.only Set)] - ["[0]" list ("[1]#[0]" monoid functor mix)]] + ["[0]" list (.open: "[1]#[0]" monoid functor mix)]] [format ["_" binary (.only Writer)]]] ["[0]" meta (.only) 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 d79a962ca..0c8e86526 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/analysis.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis.lux @@ -14,11 +14,11 @@ ["<[0]>" code]]] [data ["[0]" product] - ["[0]" bit ("[1]#[0]" equivalence)] - ["[0]" text ("[1]#[0]" equivalence) + ["[0]" bit (.open: "[1]#[0]" equivalence)] + ["[0]" text (.open: "[1]#[0]" equivalence) ["%" format (.only Format)]] [collection - ["[0]" list ("[1]#[0]" functor mix)]]] + ["[0]" list (.open: "[1]#[0]" functor mix)]]] [macro [syntax (.only syntax:)]] [math diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/complex.lux b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/complex.lux index 633d8868b..65c8db0cb 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/complex.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/complex.lux @@ -5,11 +5,11 @@ [equivalence (.only Equivalence)] [hash (.only Hash)]] [data - ["[0]" bit ("[1]#[0]" equivalence)] + ["[0]" bit (.open: "[1]#[0]" equivalence)] ["[0]" text (.only) ["%" format (.only Format)]] [collection - ["[0]" list ("[1]#[0]" functor)]]] + ["[0]" list (.open: "[1]#[0]" functor)]]] [math [number ["n" nat]]]]]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/coverage.lux b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/coverage.lux index 0a13c9c40..4573ad571 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/coverage.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/coverage.lux @@ -5,23 +5,23 @@ [equivalence (.except)] ["[0]" monad (.only do)]] [control - ["[0]" maybe ("[1]#[0]" monoid monad)] + ["[0]" maybe (.open: "[1]#[0]" monoid monad)] ["[0]" try (.only Try)] ["[0]" exception (.only exception:)]] [data - ["[0]" bit ("[1]#[0]" equivalence)] + ["[0]" bit (.open: "[1]#[0]" equivalence)] ["[0]" text (.only) ["%" format]] [collection - ["[0]" list ("[1]#[0]" functor mix)] + ["[0]" list (.open: "[1]#[0]" functor mix)] ["[0]" dictionary (.only Dictionary)] - ["[0]" set (.only Set) ("[1]#[0]" equivalence)]]] + ["[0]" set (.only Set) (.open: "[1]#[0]" equivalence)]]] [macro ["^" pattern] ["[0]" template]] [math [number - ["n" nat ("[1]#[0]" interval)] + ["n" nat (.open: "[1]#[0]" interval)] ["i" int] ["r" rev] ["f" frac]]]]] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/inference.lux b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/inference.lux index 8b3ec93ca..7ac9ebff8 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/inference.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/inference.lux @@ -13,7 +13,7 @@ ["[0]" text (.only) ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" functor monoid)]]] + ["[0]" list (.open: "[1]#[0]" functor monoid)]]] [macro ["^" pattern] ["[0]" template]] @@ -28,7 +28,7 @@ [phase ["[0]" extension]] [/// - ["[0]" phase ("[1]#[0]" monad)] + ["[0]" phase (.open: "[1]#[0]" monad)] [meta [archive (.only Archive)]]]]]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/module.lux b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/module.lux index 46ac4596a..9aabc7d10 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/module.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/module.lux @@ -8,10 +8,10 @@ ["[0]" try] ["[0]" exception (.only exception:)]] [data - ["[0]" text ("[1]#[0]" equivalence) + ["[0]" text (.open: "[1]#[0]" equivalence) ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" mix functor)] + ["[0]" list (.open: "[1]#[0]" mix functor)] [dictionary ["[0]" plist]]]] ["[0]" meta]]] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/scope.lux b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/scope.lux index 970c62d7c..bf221d35b 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/scope.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/scope.lux @@ -4,14 +4,14 @@ [abstract [monad (.only do)]] [control - ["[0]" maybe ("[1]#[0]" monad)] + ["[0]" maybe (.open: "[1]#[0]" monad)] ["[0]" try] ["[0]" exception (.only exception:)]] [data - ["[0]" text ("[1]#[0]" equivalence)] + ["[0]" text (.open: "[1]#[0]" equivalence)] ["[0]" product] [collection - ["[0]" list ("[1]#[0]" functor mix monoid)] + ["[0]" list (.open: "[1]#[0]" functor mix monoid)] [dictionary ["[0]" plist]]]]]] ["/" // (.only Environment Operation Phase) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/simple.lux b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/simple.lux index ff3deb58d..4907be964 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/simple.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/simple.lux @@ -4,8 +4,8 @@ [abstract [equivalence (.only Equivalence)]] [data - ["[0]" bit ("[1]#[0]" equivalence)] - ["[0]" text ("[1]#[0]" equivalence) + ["[0]" bit (.open: "[1]#[0]" equivalence)] + ["[0]" text (.open: "[1]#[0]" equivalence) ["%" format (.only Format)]]] [macro ["^" pattern]] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/directive.lux b/stdlib/source/library/lux/tool/compiler/language/lux/directive.lux index 39e1fae5d..7f1c5d418 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/directive.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/directive.lux @@ -7,7 +7,7 @@ ["[0]" try]] [data [collection - ["[0]" list ("[1]#[0]" monoid)]]]]] + ["[0]" list (.open: "[1]#[0]" monoid)]]]]] [// ["[0]" analysis] ["[0]" synthesis] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/generation.lux b/stdlib/source/library/lux/tool/compiler/language/lux/generation.lux index 829cbb4a4..1499d8081 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/generation.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/generation.lux @@ -10,11 +10,11 @@ [data [binary (.only Binary)] ["[0]" product] - ["[0]" text ("[1]#[0]" equivalence) + ["[0]" text (.open: "[1]#[0]" equivalence) ["%" format (.only format)]] [collection ["[0]" sequence (.only Sequence)] - ["[0]" list ("[1]#[0]" functor mix)] + ["[0]" list (.open: "[1]#[0]" functor mix)] ["[0]" set (.only Set)]]] [macro ["^" pattern] 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 7fd1b74a9..70dd51a99 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 @@ -13,7 +13,7 @@ [text ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" mix monoid monad)]]] + ["[0]" list (.open: "[1]#[0]" mix monoid monad)]]] [math [number ["n" nat]]] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/complex.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/complex.lux index 411440e41..eeb30664f 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/complex.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/complex.lux @@ -11,10 +11,10 @@ ["[0]" state]] [data ["[0]" product] - ["[0]" text ("[1]#[0]" equivalence) + ["[0]" text (.open: "[1]#[0]" equivalence) ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" monad)] + ["[0]" list (.open: "[1]#[0]" monad)] ["[0]" dictionary (.only Dictionary)]]] [macro ["[0]" code]] @@ -35,7 +35,7 @@ ["[1][0]" type] ["[1][0]" inference]] [/// - ["[1]" phase ("[1]#[0]" monad)] + ["[1]" phase (.open: "[1]#[0]" monad)] [meta [archive (.only Archive)]]]]]]) 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 57dfe4a2f..19e415b29 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 @@ -13,7 +13,7 @@ ["[0]" text (.only) ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" monoid monad)]]] + ["[0]" list (.open: "[1]#[0]" monoid monad)]]] [math [number ["n" nat]]] @@ -27,7 +27,7 @@ ["[1][0]" inference] ["[1][0]" scope]] [/// - ["[1]" phase ("[1]#[0]" functor)] + ["[1]" phase (.open: "[1]#[0]" functor)] [reference (.only) [variable (.only)]]]]]) 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 0bbb089ce..cea38091d 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 @@ -7,7 +7,7 @@ [control ["[0]" exception (.only exception:)]] [data - ["[0]" text ("[1]#[0]" equivalence) + ["[0]" text (.open: "[1]#[0]" equivalence) ["%" format (.only format)]]] [macro ["^" pattern]]]] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/directive.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/directive.lux index a007bdb45..be4a0fd6f 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/directive.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/directive.lux @@ -11,7 +11,7 @@ [text ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" mix monoid)]]]]] + ["[0]" list (.open: "[1]#[0]" mix monoid)]]]]] ["[0]" // ["[1][0]" extension] ["[1][0]" analysis] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension.lux index ed854b3cb..493776886 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension.lux @@ -11,7 +11,7 @@ ["[0]" exception (.only exception:)]] [data ["[0]" product] - ["[0]" text ("[1]#[0]" order) + ["[0]" text (.open: "[1]#[0]" order) ["%" format (.only Format format)]] [collection ["[0]" list] 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 49ac7d0fd..b7feef155 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 @@ -8,8 +8,8 @@ ["[0]" predicate]] [control ["[0]" pipe] - ["[0]" maybe ("[1]#[0]" functor)] - ["[0]" try (.only Try) ("[1]#[0]" monad)] + ["[0]" maybe (.open: "[1]#[0]" functor)] + ["[0]" try (.only Try) (.open: "[1]#[0]" monad)] ["[0]" exception (.only exception:)] ["<>" parser (.only) ["<[0]>" code (.only Parser)] @@ -17,10 +17,10 @@ [data [binary (.only Binary)] ["[0]" product] - ["[0]" text ("[1]#[0]" equivalence) + ["[0]" text (.open: "[1]#[0]" equivalence) ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" mix monad monoid)] + ["[0]" list (.open: "[1]#[0]" mix monad monoid)] ["[0]" array] ["[0]" dictionary (.only Dictionary)] ["[0]" sequence]] @@ -36,8 +36,8 @@ [target ["[0]" jvm ["[0]!" reflection] - ["_" bytecode (.only Bytecode) ("[1]#[0]" monad)] - ["[0]" modifier (.only Modifier) ("[1]#[0]" monoid)] + ["_" bytecode (.only Bytecode) (.open: "[1]#[0]" monad)] + ["[0]" modifier (.only Modifier) (.open: "[1]#[0]" monoid)] ["[0]" attribute] ["[0]" field] ["[0]" version] @@ -47,7 +47,7 @@ ["[0]" pool (.only Resource)]] [encoding ["[0]" name (.only External)]] - ["[1]" type (.only Type Argument Typed) ("[1]#[0]" equivalence) + ["[1]" type (.only Type Argument Typed) (.open: "[1]#[0]" equivalence) ["[0]" category (.only Void Value' Value Return' Return Primitive Object Class Array Var Parameter Method)] ["[0]" box] ["[0]" reflection] @@ -57,7 +57,7 @@ ["[0]" alias (.only Aliasing)] ["[0]T" lux (.only Mapping)]]]] ["[0]" type (.only) - ["[0]" check (.only Check) ("[1]#[0]" monad)]]]] + ["[0]" check (.only Check) (.open: "[1]#[0]" monad)]]]] ["[0]" // ["[1][0]" lux (.only custom)] ["/[1]" // (.only) @@ -78,7 +78,7 @@ ["[0]A" type] ["[0]" scope]] [/// - ["[0]" phase ("[1]#[0]" monad)] + ["[0]" phase (.open: "[1]#[0]" monad)] [meta [archive (.only Archive) [module 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 3f973aadb..76f36e336 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 @@ -13,7 +13,7 @@ ["[0]" text (.only) ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" functor)] + ["[0]" list (.open: "[1]#[0]" functor)] ["[0]" dictionary (.only Dictionary)]]] [macro ["^" pattern]] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/bundle.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/bundle.lux index 7929f2f83..b770c31cc 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/bundle.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/bundle.lux @@ -7,7 +7,7 @@ ["[0]" text (.only) ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" functor)] + ["[0]" list (.open: "[1]#[0]" functor)] ["[0]" dictionary (.only Dictionary)]]]]] [// (.only Handler Bundle)]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux index 4bf7e260c..025e863d3 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux @@ -6,9 +6,9 @@ ["[0]" monad (.only do)]] [control ["[0]" pipe] - ["[0]" try (.only Try) ("[1]#[0]" functor)] + ["[0]" try (.only Try) (.open: "[1]#[0]" functor)] ["[0]" exception] - ["<>" parser ("[1]#[0]" monad) + ["<>" parser (.open: "[1]#[0]" monad) ["<[0]>" code (.only Parser)] ["<[0]>" text] ["<[0]>" synthesis]]] @@ -18,7 +18,7 @@ [text ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" functor mix)] + ["[0]" list (.open: "[1]#[0]" functor mix)] ["[0]" dictionary] ["[0]" sequence] ["[0]" set (.only Set)]] @@ -33,8 +33,8 @@ ["[0]" i32]]] [target [jvm - ["_" bytecode (.only Bytecode) ("[1]#[0]" monad)] - ["[0]" modifier (.only Modifier) ("[1]#[0]" monoid)] + ["_" bytecode (.only Bytecode) (.open: "[1]#[0]" monad)] + ["[0]" modifier (.only Modifier) (.open: "[1]#[0]" monoid)] ["[0]" attribute] ["[0]" field] ["[0]" version] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux index b8302f85c..b66e2cc05 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux @@ -7,7 +7,7 @@ ["[0]" monad (.only do)]] [control [io (.only IO)] - ["[0]" maybe ("[1]#[0]" functor)] + ["[0]" maybe (.open: "[1]#[0]" functor)] ["[0]" try] ["[0]" exception (.only exception:)] ["<>" parser (.only) @@ -20,7 +20,7 @@ [collection ["[0]" dictionary] ["[0]" array] - ["[0]" list ("[1]#[0]" functor mix)] + ["[0]" list (.open: "[1]#[0]" functor mix)] ["[0]" set (.only Set)]]] [macro ["^" pattern] @@ -28,7 +28,7 @@ [math [number ["n" nat]]] - ["[0]" type (.only sharing) ("[1]#[0]" equivalence) + ["[0]" type (.only sharing) (.open: "[1]#[0]" equivalence) ["[0]" check]]]] ["[0]" /// (.only Extender) ["[1][0]" bundle] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/common_lisp/common.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/common_lisp/common.lux index 49681e787..355dd5182 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/common_lisp/common.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/common_lisp/common.lux @@ -15,7 +15,7 @@ [collection ["[0]" dictionary] ["[0]" set] - ["[0]" list ("[1]#[0]" functor mix)]]] + ["[0]" list (.open: "[1]#[0]" functor mix)]]] [math [number ["f" frac]]] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux index b12fc2949..f9ad9a81e 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux @@ -10,7 +10,7 @@ [data ["[0]" product] [collection - ["[0]" list ("[1]#[0]" functor)] + ["[0]" list (.open: "[1]#[0]" functor)] ["[0]" dictionary]]] [macro ["^" pattern]] @@ -37,7 +37,7 @@ [// ["[0]" synthesis (.only %synthesis)] [/// - ["[1]" phase ("[1]#[0]" monad)]]]]]) + ["[1]" phase (.open: "[1]#[0]" monad)]]]]]) (def: .public (custom [parser handler]) (All (_ s) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux index 2da6d5756..cbae57e3c 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux @@ -11,7 +11,7 @@ [data ["[0]" product] [collection - ["[0]" list ("[1]#[0]" monad)] + ["[0]" list (.open: "[1]#[0]" monad)] ["[0]" dictionary]]] [math [number @@ -19,7 +19,7 @@ ["[0]" i32]]] [target [jvm - ["_" bytecode (.only Label Bytecode) ("[1]#[0]" monad)] + ["_" bytecode (.only Label Bytecode) (.open: "[1]#[0]" monad)] [encoding ["[0]" signed (.only S4)]] ["[0]" type (.only Type) 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 eaf40a8ee..4e60e6693 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 @@ -4,17 +4,17 @@ [abstract ["[0]" monad (.only do)]] [control - ["[0]" maybe ("[1]#[0]" functor)] + ["[0]" maybe (.open: "[1]#[0]" functor)] ["[0]" exception (.only exception:)] ["<>" parser (.only) ["<[0]>" text] ["<[0]>" synthesis (.only Parser)]]] [data ["[0]" product] - ["[0]" text ("[1]#[0]" equivalence) + ["[0]" text (.open: "[1]#[0]" equivalence) ["%" format]] [collection - ["[0]" list ("[1]#[0]" monad mix monoid)] + ["[0]" list (.open: "[1]#[0]" monad mix monoid)] ["[0]" dictionary (.only Dictionary)] ["[0]" set (.only Set)] ["[0]" sequence]] @@ -30,14 +30,14 @@ [target [jvm ["[0]" version] - ["[0]" modifier ("[1]#[0]" monoid)] + ["[0]" modifier (.open: "[1]#[0]" monoid)] ["[0]" method (.only Method)] ["[0]" class (.only Class)] [constant [pool (.only Resource)]] [encoding ["[0]" name]] - ["_" bytecode (.only Bytecode) ("[1]#[0]" monad) + ["_" bytecode (.only Bytecode) (.open: "[1]#[0]" monad) ["__" instruction (.only Primitive_Array_Type)]] ["[0]" type (.only Type Typed Argument) ["[0]" category (.only Void Value' Value Return' Return Primitive Object Array Var Parameter)] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/lua/common.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/lua/common.lux index f06cab2c6..834d3448c 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/lua/common.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/lua/common.lux @@ -14,7 +14,7 @@ ["%" format (.only format)]] [collection ["[0]" dictionary] - ["[0]" list ("[1]#[0]" functor mix)]]] + ["[0]" list (.open: "[1]#[0]" functor mix)]]] [macro ["^" pattern]] [math @@ -41,7 +41,7 @@ ["[0]" synthesis (.only %synthesis)] ["[0]" generation] [/// - ["[1]" phase ("[1]#[0]" monad)]]]]]) + ["[1]" phase (.open: "[1]#[0]" monad)]]]]]) (def: .public (custom [parser handler]) (All (_ s) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/php/common.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/php/common.lux index 25eeba0bc..ef05fe70f 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/php/common.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/php/common.lux @@ -15,7 +15,7 @@ [collection ["[0]" dictionary] ["[0]" set] - ["[0]" list ("[1]#[0]" functor mix)]]] + ["[0]" list (.open: "[1]#[0]" functor mix)]]] [math [number ["f" frac]]] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux index b7219747b..22ffda36e 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux @@ -14,7 +14,7 @@ ["%" format (.only format)]] [collection ["[0]" dictionary] - ["[0]" list ("[1]#[0]" functor mix)]]] + ["[0]" list (.open: "[1]#[0]" functor mix)]]] [macro ["^" pattern]] [math @@ -43,7 +43,7 @@ ["[0]" synthesis (.only %synthesis)] ["[0]" generation] [/// - ["[1]" phase ("[1]#[0]" monad)]]]]]) + ["[1]" phase (.open: "[1]#[0]" monad)]]]]]) (def: .public (statement expression archive synthesis) Phase! diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/r/common.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/r/common.lux index afd160be3..35e433e8e 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/r/common.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/r/common.lux @@ -15,7 +15,7 @@ [collection ["[0]" dictionary] ["[0]" set] - ["[0]" list ("[1]#[0]" functor mix)]]] + ["[0]" list (.open: "[1]#[0]" functor mix)]]] [math [number ["f" frac]]] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/ruby/common.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/ruby/common.lux index c0bfdf7ed..e7395899b 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/ruby/common.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/ruby/common.lux @@ -14,7 +14,7 @@ ["%" format (.only format)]] [collection ["[0]" dictionary] - ["[0]" list ("[1]#[0]" functor mix)]]] + ["[0]" list (.open: "[1]#[0]" functor mix)]]] [macro ["^" pattern]] [math @@ -41,7 +41,7 @@ ["[0]" synthesis (.only %synthesis)] ["[0]" generation] [/// - ["[1]" phase ("[1]#[0]" monad)]]]]]) + ["[1]" phase (.open: "[1]#[0]" monad)]]]]]) (def: .public (custom [parser handler]) (All (_ s) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/scheme/common.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/scheme/common.lux index 8d445eb3c..9dbea2892 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/scheme/common.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/scheme/common.lux @@ -15,7 +15,7 @@ [collection ["[0]" dictionary] ["[0]" set] - ["[0]" list ("[1]#[0]" functor mix)]]] + ["[0]" list (.open: "[1]#[0]" functor mix)]]] [math [number ["f" frac]]] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp.lux index f88c04f0a..33572414f 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp.lux @@ -21,7 +21,7 @@ [analysis (.only)] ["[1][0]" synthesis] ["//[1]" /// - ["[1][0]" phase ("[1]#[0]" monad)] + ["[1][0]" phase (.open: "[1]#[0]" monad)] [reference (.only) [variable (.only)]]]]]]]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/case.lux index 6f93eb386..7a5c774c4 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/case.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/case.lux @@ -9,7 +9,7 @@ ["[0]" text (.only) ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" functor mix monoid)] + ["[0]" list (.open: "[1]#[0]" functor mix monoid)] ["[0]" set]]] [macro ["^" pattern]] @@ -33,7 +33,7 @@ ["//[1]" /// [reference ["[1][0]" variable (.only Register)]] - ["[1][0]" phase ("[1]#[0]" monad)] + ["[1][0]" phase (.open: "[1]#[0]" monad)] [meta [archive (.only Archive)]]]]]]]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/function.lux index 412bf27b7..77569b17e 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/function.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/function.lux @@ -10,7 +10,7 @@ [text ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" functor)]]] + ["[0]" list (.open: "[1]#[0]" functor)]]] [target ["_" common_lisp (.only Expression Var/1)]]]] ["[0]" // @@ -25,7 +25,7 @@ ["[1][0]" generation (.only Context)] ["//[1]" /// [arity (.only Arity)] - ["[1][0]" phase ("[1]#[0]" monad)] + ["[1][0]" phase (.open: "[1]#[0]" monad)] [reference [variable (.only Register Variable)]]]]]]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/loop.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/loop.lux index d80a015e6..287d9a6c3 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/loop.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/loop.lux @@ -8,7 +8,7 @@ [text ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" functor)]]] + ["[0]" list (.open: "[1]#[0]" functor)]]] [math [number ["n" nat]]] 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 efbf5c321..e9bbd9a5c 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 @@ -10,11 +10,11 @@ ["<[0]>" code]]] [data ["[0]" product] - ["[0]" text ("[1]#[0]" hash) + ["[0]" text (.open: "[1]#[0]" hash) ["%" format (.only format)] ["[0]" encoding]] [collection - ["[0]" list ("[1]#[0]" functor monoid)] + ["[0]" list (.open: "[1]#[0]" functor monoid)] ["[0]" sequence]]] ["[0]" macro (.only) [syntax (.only syntax:)] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/structure.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/structure.lux index 4498fdb1f..b14e852b1 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/structure.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/structure.lux @@ -12,7 +12,7 @@ [analysis (.only Variant Tuple)] ["[1][0]" synthesis (.only Synthesis)] ["//[1]" /// - ["[1][0]" phase ("[1]#[0]" monad)]]]]) + ["[1][0]" phase (.open: "[1]#[0]" monad)]]]]) (def: .public (tuple expression archive elemsS+) (Generator (Tuple Synthesis)) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/extension.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/extension.lux index 5bfe69fea..317114afc 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/extension.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/extension.lux @@ -8,7 +8,7 @@ ["<[0]>" code]]] [data [collection - ["[0]" list ("[1]#[0]" functor)]]] + ["[0]" list (.open: "[1]#[0]" functor)]]] ["[0]" meta] ["[0]" macro (.only with_symbols) ["[0]" code] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js.lux index dde4dcea2..02540a965 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js.lux @@ -28,7 +28,7 @@ [analysis (.only)] ["[0]" synthesis] ["//[1]" /// - ["[1][0]" phase ("[1]#[0]" monad)] + ["[1][0]" phase (.open: "[1]#[0]" monad)] [reference (.only) [variable (.only)]]]]]]]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/case.lux index 13d1ed400..9afe42e0c 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/case.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/case.lux @@ -8,7 +8,7 @@ [data ["[0]" text] [collection - ["[0]" list ("[1]#[0]" functor mix)]]] + ["[0]" list (.open: "[1]#[0]" functor mix)]]] [macro ["^" pattern]] [math @@ -32,7 +32,7 @@ ["//[1]" /// [reference [variable (.only Register)]] - ["[1][0]" phase ("[1]#[0]" monad)] + ["[1][0]" phase (.open: "[1]#[0]" monad)] [meta [archive (.only Archive)]]]]]]]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/function.lux index 69db5cdd4..69b575162 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/function.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/function.lux @@ -8,7 +8,7 @@ [text ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" functor mix)]]] + ["[0]" list (.open: "[1]#[0]" functor mix)]]] [target ["_" js (.only Expression Computation Var Statement)]]]] ["[0]" // @@ -23,7 +23,7 @@ ["[1][0]" generation] ["//[1]" /// [arity (.only Arity)] - ["[1][0]" phase ("[1]#[0]" monad)] + ["[1][0]" phase (.open: "[1]#[0]" monad)] [reference [variable (.only Register Variable)]] [meta diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/loop.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/loop.lux index 32823cd17..9849f3981 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/loop.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/loop.lux @@ -8,7 +8,7 @@ ["[0]" text (.only) ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" functor mix)]]] + ["[0]" list (.open: "[1]#[0]" functor mix)]]] [math [number ["n" nat]]] 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 5605d56ee..12359b713 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 @@ -10,12 +10,12 @@ ["<[0]>" code]]] [data ["[0]" product] - ["[0]" text ("[1]#[0]" hash) + ["[0]" text (.open: "[1]#[0]" hash) ["%" format (.only format)] [encoding ["[0]" utf8]]] [collection - ["[0]" list ("[1]#[0]" functor)] + ["[0]" list (.open: "[1]#[0]" functor)] ["[0]" sequence]]] ["[0]" macro (.only) [syntax (.only syntax:)] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/structure.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/structure.lux index b57b4b344..14e911912 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/structure.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/structure.lux @@ -13,7 +13,7 @@ [analysis [complex (.only Variant Tuple)]] ["//[1]" /// (.only) - ["[1][0]" phase ("[1]#[0]" monad)]]]]) + ["[1][0]" phase (.open: "[1]#[0]" monad)]]]]) (def: .public (tuple generate archive elemsS+) (Generator (Tuple Synthesis)) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm.lux index 73c286f0c..c4b026541 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm.lux @@ -19,7 +19,7 @@ ["[0]" synthesis] [/// ["[0]" reference] - ["[1]" phase ("[1]#[0]" monad)]]]]]) + ["[1]" phase (.open: "[1]#[0]" monad)]]]]]) (def: .public (generate archive synthesis) Phase 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 e718b504d..8fb2dcd0c 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 @@ -7,8 +7,8 @@ ["[0]" function]] [data [collection - ["[0]" list ("[1]#[0]" mix)]] - ["[0]" text ("[1]#[0]" equivalence) + ["[0]" list (.open: "[1]#[0]" mix)]] + ["[0]" text (.open: "[1]#[0]" equivalence) ["%" format (.only format)]]] [macro ["^" pattern]] @@ -18,7 +18,7 @@ ["[0]" i32]]] [target [jvm - ["_" bytecode (.only Label Bytecode) ("[1]#[0]" monad) + ["_" bytecode (.only Label Bytecode) (.open: "[1]#[0]" monad) [environment [limit ["[0]" stack]]]] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux index b89b43d67..28e90a032 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux @@ -6,7 +6,7 @@ [data ["[0]" product] [collection - ["[0]" list ("[1]#[0]" monoid functor)] + ["[0]" list (.open: "[1]#[0]" monoid functor)] ["[0]" sequence]] ["[0]" format ["[1]" binary]]] @@ -17,10 +17,10 @@ [target [jvm ["[0]" version] - ["[0]" modifier (.only Modifier) ("[1]#[0]" monoid)] + ["[0]" modifier (.only Modifier) (.open: "[1]#[0]" monoid)] ["[0]" field (.only Field)] ["[0]" method (.only Method)] - ["_" bytecode (.only Label Bytecode) ("[1]#[0]" monad)] + ["_" bytecode (.only Label Bytecode) (.open: "[1]#[0]" monad)] ["[0]" class (.only Class)] ["[0]" type (.only Type) [category (.only Return' Value')] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/constant.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/constant.lux index 7d2ad1f85..4aea4dc4f 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/constant.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/constant.lux @@ -7,7 +7,7 @@ [target [jvm ["[0]" field (.only Field)] - ["[0]" modifier (.only Modifier) ("[1]#[0]" monoid)] + ["[0]" modifier (.only Modifier) (.open: "[1]#[0]" monoid)] [type (.only Type) [category (.only Value)]] [constant diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable.lux index 2a0bc8cd9..737c6ac4b 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable.lux @@ -3,11 +3,11 @@ [lux (.except Type type) [data [collection - ["[0]" list ("[1]#[0]" functor)] + ["[0]" list (.open: "[1]#[0]" functor)] ["[0]" sequence]]] [target [jvm - ["[0]" modifier (.only Modifier) ("[1]#[0]" monoid)] + ["[0]" modifier (.only Modifier) (.open: "[1]#[0]" monoid)] ["[0]" field (.only Field)] ["_" bytecode (.only Bytecode)] [type (.only Type) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable/partial.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable/partial.lux index 810ce179e..1684e6f8c 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable/partial.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable/partial.lux @@ -5,14 +5,14 @@ ["[0]" monad]] [data [collection - ["[0]" list ("[1]#[0]" functor)]]] + ["[0]" list (.open: "[1]#[0]" functor)]]] [math [number ["n" nat]]] [target [jvm ["[0]" field (.only Field)] - ["_" bytecode (.only Bytecode) ("[1]#[0]" monad)] + ["_" bytecode (.only Bytecode) (.open: "[1]#[0]" monad)] [type (.only Type) [category (.only Class)]] [constant diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method.lux index 83a14abc9..1301e055c 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method.lux @@ -3,7 +3,7 @@ [lux (.except) [target [jvm - ["[0]" modifier (.only Modifier) ("[1]#[0]" monoid)] + ["[0]" modifier (.only Modifier) (.open: "[1]#[0]" monoid)] ["[0]" method (.only Method)]]]]]) (def: .public modifier 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 19f568571..69e7d5332 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 @@ -7,7 +7,7 @@ ["[0]" try]] [data [collection - ["[0]" list ("[1]#[0]" monoid functor)]]] + ["[0]" list (.open: "[1]#[0]" monoid functor)]]] [math [number ["n" nat] @@ -15,7 +15,7 @@ ["[0]" i32]]] [target [jvm - ["_" bytecode (.only Label Bytecode) ("[1]#[0]" monad)] + ["_" bytecode (.only Label Bytecode) (.open: "[1]#[0]" monad)] ["[0]" method (.only Method)] [constant [pool (.only Resource)]] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/implementation.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/implementation.lux index 53f43707d..e7e970d87 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/implementation.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/implementation.lux @@ -9,7 +9,7 @@ ["n" nat]]] [target [jvm - ["[0]" modifier (.only Modifier) ("[1]#[0]" monoid)] + ["[0]" modifier (.only Modifier) (.open: "[1]#[0]" monoid)] ["[0]" method (.only Method)] ["_" bytecode (.only Label Bytecode)] [constant 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 da0d00cb2..32a1e4de8 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 @@ -7,7 +7,7 @@ ["[0]" try]] [data [collection - ["[0]" list ("[1]#[0]" monoid functor)]]] + ["[0]" list (.open: "[1]#[0]" monoid functor)]]] [math [number ["n" nat]]] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/reset.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/reset.lux index f52b7d682..51ceaf844 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/reset.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/reset.lux @@ -3,7 +3,7 @@ [lux (.except Type type) [data [collection - ["[0]" list ("[1]#[0]" functor)]]] + ["[0]" list (.open: "[1]#[0]" functor)]]] [target [jvm ["[0]" method (.only Method)] 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 dc28346dc..ebd1008a1 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 @@ -14,7 +14,7 @@ [data [binary (.only Binary)] ["[0]" product] - ["[0]" text ("[1]#[0]" hash) + ["[0]" text (.open: "[1]#[0]" hash) ["%" format (.only format)]] [collection ["[0]" array] @@ -26,7 +26,7 @@ [jvm ["_" bytecode (.only Bytecode)] ["[0]" loader (.only Library)] - ["[0]" modifier (.only Modifier) ("[1]#[0]" monoid)] + ["[0]" modifier (.only Modifier) (.open: "[1]#[0]" monoid)] ["[0]" field (.only Field)] ["[0]" method (.only Method)] ["[0]" version] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/loop.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/loop.lux index a0d7cffbc..f06d37da3 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/loop.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/loop.lux @@ -8,13 +8,13 @@ [data ["[0]" product] [collection - ["[0]" list ("[1]#[0]" functor)]]] + ["[0]" list (.open: "[1]#[0]" functor)]]] [math [number ["n" nat]]] [target [jvm - ["_" bytecode (.only Bytecode) ("[1]#[0]" monad)]]]]] + ["_" bytecode (.only Bytecode) (.open: "[1]#[0]" monad)]]]]] ["[0]" // ["[1][0]" runtime (.only Operation Phase Generator)] ["[1][0]" value] 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 94df434f2..6f9aa8aa3 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 @@ -13,7 +13,7 @@ [target [jvm ["_" bytecode (.only Bytecode)] - ["[0]" modifier (.only Modifier) ("[1]#[0]" monoid)] + ["[0]" modifier (.only Modifier) (.open: "[1]#[0]" monoid)] ["[0]" method (.only Method)] ["[0]" version] ["[0]" class (.only Class)] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux index 9ff51ff95..d923ea65d 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux @@ -10,7 +10,7 @@ [binary (.only Binary)] ["[0]" product] [collection - ["[0]" list ("[1]#[0]" functor)] + ["[0]" list (.open: "[1]#[0]" functor)] ["[0]" sequence]] ["[0]" format ["[1]" binary]] @@ -26,7 +26,7 @@ [target ["[0]" jvm ["_" bytecode (.only Label Bytecode)] - ["[0]" modifier (.only Modifier) ("[1]#[0]" monoid)] + ["[0]" modifier (.only Modifier) (.open: "[1]#[0]" monoid)] ["[0]" field (.only Field)] ["[0]" method (.only Method)] ["[1]/[0]" version] 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 d2fdbb1cc..a415f60fa 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 @@ -4,7 +4,7 @@ [target [jvm ["_" bytecode (.only Bytecode)] - ["[0]" type (.only Type) ("[1]#[0]" equivalence) + ["[0]" type (.only Type) (.open: "[1]#[0]" equivalence) [category (.only Primitive)] ["[0]" box]]]]]]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua.lux index 859c60b50..8d861e382 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua.lux @@ -28,7 +28,7 @@ [analysis (.only)] ["[0]" synthesis] ["//[1]" /// - ["[1][0]" phase ("[1]#[0]" monad)] + ["[1][0]" phase (.open: "[1]#[0]" monad)] [reference (.only) [variable (.only)]]]]]]]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/case.lux index 59d0fa42d..c65093838 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/case.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/case.lux @@ -7,7 +7,7 @@ ["[0]" text (.only) ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" functor mix)] + ["[0]" list (.open: "[1]#[0]" functor mix)] ["[0]" set]]] [macro ["^" pattern]] @@ -30,7 +30,7 @@ ["//[1]" /// [reference ["[1][0]" variable (.only Register)]] - ["[1][0]" phase ("[1]#[0]" monad)] + ["[1][0]" phase (.open: "[1]#[0]" monad)] [meta [archive (.only Archive)]]]]]]]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/function.lux index d2907e282..a8757090a 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/function.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/function.lux @@ -8,7 +8,7 @@ [text ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" functor mix)]]] + ["[0]" list (.open: "[1]#[0]" functor mix)]]] [target ["_" lua (.only Var Expression Label Statement)]]]] ["[0]" // @@ -23,7 +23,7 @@ ["[1][0]" generation] ["//[1]" /// [arity (.only Arity)] - ["[1][0]" phase ("[1]#[0]" monad)] + ["[1][0]" phase (.open: "[1]#[0]" monad)] [meta [archive ["[0]" unit]] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux index 66b05a97e..c79123870 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux @@ -8,7 +8,7 @@ [text ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" functor)] + ["[0]" list (.open: "[1]#[0]" functor)] ["[0]" set]]] [math [number 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 4f31dd592..9b72bdf74 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 @@ -10,12 +10,12 @@ ["<[0]>" code]]] [data ["[0]" product] - ["[0]" text ("[1]#[0]" hash) + ["[0]" text (.open: "[1]#[0]" hash) ["%" format (.only format)] [encoding ["[0]" utf8]]] [collection - ["[0]" list ("[1]#[0]" functor)] + ["[0]" list (.open: "[1]#[0]" functor)] ["[0]" sequence]]] ["[0]" macro (.only) [syntax (.only syntax:)] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/structure.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/structure.lux index 1b8610f2b..65ed33699 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/structure.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/structure.lux @@ -13,7 +13,7 @@ [analysis [complex (.only Variant Tuple)]] ["//[1]" /// - ["[1][0]" phase ("[1]#[0]" monad)]]]]) + ["[1][0]" phase (.open: "[1]#[0]" monad)]]]]) (def: .public (tuple phase archive elemsS+) (Generator (Tuple Synthesis)) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php.lux index 38c06a8c2..3d2107867 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php.lux @@ -25,7 +25,7 @@ [analysis (.only)] ["[1][0]" synthesis] ["//[1]" /// - ["[1][0]" phase ("[1]#[0]" monad)] + ["[1][0]" phase (.open: "[1]#[0]" monad)] [reference (.only) [variable (.only)]]]]]]]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/case.lux index 03c82f322..9815d9e3e 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/case.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/case.lux @@ -8,7 +8,7 @@ ["[0]" text (.only) ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" functor mix)] + ["[0]" list (.open: "[1]#[0]" functor mix)] ["[0]" set]]] [macro ["^" pattern]] @@ -32,7 +32,7 @@ ["//[1]" /// [reference ["[1][0]" variable (.only Register)]] - ["[1][0]" phase ("[1]#[0]" monad)] + ["[1][0]" phase (.open: "[1]#[0]" monad)] [meta [archive (.only Archive)]]]]]]]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/function.lux index e304677d2..b6c9d1ab2 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/function.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/function.lux @@ -10,7 +10,7 @@ ["[0]" text (.only) ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" functor mix)]]] + ["[0]" list (.open: "[1]#[0]" functor mix)]]] [target ["_" php (.only Var Global Expression Argument Label Statement)]]]] ["[0]" // @@ -25,7 +25,7 @@ ["[1][0]" generation (.only Context)] ["//[1]" /// [arity (.only Arity)] - ["[1][0]" phase ("[1]#[0]" monad)] + ["[1][0]" phase (.open: "[1]#[0]" monad)] [reference [variable (.only Register Variable)]]]]]]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/loop.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/loop.lux index 5fab85e16..633b2c724 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/loop.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/loop.lux @@ -8,7 +8,7 @@ ["[0]" text (.only) ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" functor mix)] + ["[0]" list (.open: "[1]#[0]" functor mix)] ["[0]" set (.only Set)]]] [math [number 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 68b9671b1..649463554 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 @@ -10,12 +10,12 @@ ["<[0]>" code]]] [data ["[0]" product] - ["[0]" text ("[1]#[0]" hash) + ["[0]" text (.open: "[1]#[0]" hash) ["%" format (.only format)] [encoding ["[0]" utf8]]] [collection - ["[0]" list ("[1]#[0]" functor)] + ["[0]" list (.open: "[1]#[0]" functor)] ["[0]" sequence]]] ["[0]" macro (.only) [syntax (.only syntax:)] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/structure.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/structure.lux index e843e0676..d7a945e58 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/structure.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/structure.lux @@ -15,7 +15,7 @@ [analysis (.only Variant Tuple)] ["[1][0]" synthesis (.only Synthesis)] ["//[1]" /// - ["[1][0]" phase ("[1]#[0]" monad)]]]]) + ["[1][0]" phase (.open: "[1]#[0]" monad)]]]]) (def: .public (tuple expression archive elemsS+) (Generator (Tuple Synthesis)) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python.lux index 96a5ebc4e..f3e8d85b8 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python.lux @@ -28,7 +28,7 @@ [analysis (.only)] ["[1][0]" synthesis] ["//[1]" /// - ["[1][0]" phase ("[1]#[0]" monad)] + ["[1][0]" phase (.open: "[1]#[0]" monad)] [reference (.only) [variable (.only)]]]]]]]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/case.lux index cbf957e34..dbb669dd8 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/case.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/case.lux @@ -7,7 +7,7 @@ ["[0]" text (.only) ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" functor mix)] + ["[0]" list (.open: "[1]#[0]" functor mix)] ["[0]" set]]] [macro ["^" pattern]] @@ -34,7 +34,7 @@ ["//[1]" /// [reference ["[1][0]" variable (.only Register)]] - ["[1][0]" phase ("[1]#[0]" monad)] + ["[1][0]" phase (.open: "[1]#[0]" monad)] [meta [archive (.only Archive)] ["[0]" cache diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/function.lux index ee09d8060..feb8d0c26 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/function.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/function.lux @@ -8,7 +8,7 @@ [text ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" functor mix)]]] + ["[0]" list (.open: "[1]#[0]" functor mix)]]] [target ["_" python (.only SVar Expression Statement)]]]] ["[0]" // diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/loop.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/loop.lux index d48bad978..d4e202ffc 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/loop.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/loop.lux @@ -8,7 +8,7 @@ [text ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" functor mix)] + ["[0]" list (.open: "[1]#[0]" functor mix)] ["[0]" set]]] [math [number 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 135f8db40..bc10a524b 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 @@ -9,12 +9,12 @@ ["<[0]>" code]]] [data ["[0]" product] - ["[0]" text ("[1]#[0]" hash) + ["[0]" text (.open: "[1]#[0]" hash) ["%" format (.only format)] [encoding ["[0]" utf8]]] [collection - ["[0]" list ("[1]#[0]" functor)] + ["[0]" list (.open: "[1]#[0]" functor)] ["[0]" sequence]]] ["[0]" macro (.only) [syntax (.only syntax:)] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/structure.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/structure.lux index d8e397694..560fb1c49 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/structure.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/structure.lux @@ -13,7 +13,7 @@ [complex (.only Variant Tuple)]] ["[1][0]" synthesis (.only Synthesis)] ["//[1]" /// - ["[1][0]" phase ("[1]#[0]" monad)]]]]) + ["[1][0]" phase (.open: "[1]#[0]" monad)]]]]) (def: .public (tuple generate archive elemsS+) (Generator (Tuple Synthesis)) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r.lux index 8c8ec4fea..3e4cf4f0e 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r.lux @@ -23,7 +23,7 @@ [analysis (.only)] ["[1][0]" synthesis] ["//[1]" /// - ["[1][0]" phase ("[1]#[0]" monad)] + ["[1][0]" phase (.open: "[1]#[0]" monad)] [reference (.only) [variable (.only)]]]]]]]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/case.lux index 60f553909..1ad75fe08 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/case.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/case.lux @@ -8,7 +8,7 @@ ["[0]" text (.only) ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" functor mix)] + ["[0]" list (.open: "[1]#[0]" functor mix)] ["[0]" set]]] [macro ["^" pattern] @@ -33,7 +33,7 @@ ["//[1]" /// [reference ["[1][0]" variable (.only Register)]] - ["[1][0]" phase ("[1]#[0]" monad)] + ["[1][0]" phase (.open: "[1]#[0]" monad)] [meta [archive (.only Archive)]]]]]]]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/function.lux index a523fc621..59b92e776 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/function.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/function.lux @@ -10,7 +10,7 @@ ["[0]" text (.only) ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" functor mix)]]] + ["[0]" list (.open: "[1]#[0]" functor mix)]]] [target ["_" r (.only Expression SVar)]]]] ["[0]" // @@ -25,7 +25,7 @@ ["[1][0]" generation (.only Context)] ["//[1]" /// [arity (.only Arity)] - ["[1][0]" phase ("[1]#[0]" monad)] + ["[1][0]" phase (.open: "[1]#[0]" monad)] [reference [variable (.only Register Variable)]] [meta diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/loop.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/loop.lux index c71e536d2..f3756aad8 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/loop.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/loop.lux @@ -8,7 +8,7 @@ ["[0]" text (.only) ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" functor)] + ["[0]" list (.open: "[1]#[0]" functor)] ["[0]" set (.only Set)]]] [math [number 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 9bee4f953..e430bfaff 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 @@ -10,12 +10,12 @@ ["<[0]>" code]]] [data ["[0]" product] - ["[0]" text ("[1]#[0]" hash) + ["[0]" text (.open: "[1]#[0]" hash) ["%" format (.only format)] [encoding ["[0]" utf8]]] [collection - ["[0]" list ("[1]#[0]" functor)] + ["[0]" list (.open: "[1]#[0]" functor)] ["[0]" sequence]]] ["[0]" macro (.only) [syntax (.only syntax:)] @@ -23,7 +23,7 @@ [math [number (.only hex) ["n" nat] - ["i" int ("[1]#[0]" interval)] + ["i" int (.open: "[1]#[0]" interval)] ["[0]" i64]]] ["@" target (.only) ["_" r (.only SVar Expression)]]]] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/structure.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/structure.lux index 82dc15ca4..f41b3268d 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/structure.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/structure.lux @@ -15,7 +15,7 @@ [analysis (.only Variant Tuple)] ["[1][0]" synthesis (.only Synthesis)] ["//[1]" /// - ["[1][0]" phase ("[1]#[0]" monad)]]]]) + ["[1][0]" phase (.open: "[1]#[0]" monad)]]]]) (def: .public (tuple expression archive elemsS+) (Generator (Tuple Synthesis)) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/reference.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/reference.lux index 0c7d531b9..f93648d04 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/reference.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/reference.lux @@ -10,7 +10,7 @@ ["[0]" //// ["[1][0]" generation] ["//[1]" /// - ["[0]" phase ("[1]#[0]" monad)] + ["[0]" phase (.open: "[1]#[0]" monad)] ["[0]" reference (.only Reference) ["[0]" variable (.only Register Variable)]] [meta diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby.lux index 218c8f226..f0e8638e4 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby.lux @@ -28,7 +28,7 @@ [analysis (.only)] ["[1][0]" synthesis] ["//[1]" /// - ["[1][0]" phase ("[1]#[0]" monad)] + ["[1][0]" phase (.open: "[1]#[0]" monad)] [reference (.only) [variable (.only)]]]]]]]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/case.lux index bf7a4bc42..0f805e277 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/case.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/case.lux @@ -9,7 +9,7 @@ ["[0]" text (.only) ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" functor mix)] + ["[0]" list (.open: "[1]#[0]" functor mix)] ["[0]" set]]] [macro ["^" pattern]] @@ -36,7 +36,7 @@ ["//[1]" /// [reference ["[1][0]" variable (.only Register)]] - ["[1][0]" phase ("[1]#[0]" monad)] + ["[1][0]" phase (.open: "[1]#[0]" monad)] [meta [archive (.only Archive)]]]]]]]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux index c32ea1cc3..d0ff811b2 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux @@ -8,7 +8,7 @@ [text ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" functor mix)]]] + ["[0]" list (.open: "[1]#[0]" functor mix)]]] [target ["_" ruby (.only LVar GVar Expression Statement)]]]] ["[0]" // diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/loop.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/loop.lux index e5acb087a..3686ad6d9 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/loop.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/loop.lux @@ -8,7 +8,7 @@ ["[0]" text (.only) ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" functor mix)] + ["[0]" list (.open: "[1]#[0]" functor mix)] ["[0]" set]]] [math [number 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 bb811fc61..e309396f2 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 @@ -10,12 +10,12 @@ ["<[0]>" code]]] [data ["[0]" product] - ["[0]" text ("[1]#[0]" hash) + ["[0]" text (.open: "[1]#[0]" hash) ["%" format (.only format)] [encoding ["[0]" utf8]]] [collection - ["[0]" list ("[1]#[0]" functor mix)] + ["[0]" list (.open: "[1]#[0]" functor mix)] ["[0]" sequence]]] ["[0]" macro (.only) [syntax (.only syntax:)] @@ -23,7 +23,7 @@ [math [number (.only hex) ["[0]" i64] - ["[0]" int ("[1]#[0]" interval)]]] + ["[0]" int (.open: "[1]#[0]" interval)]]] ["@" target (.only) ["_" ruby (.only Expression LVar Computation Literal Statement)]]]] ["[0]" /// diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/structure.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/structure.lux index 4ebe22359..791f06d76 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/structure.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/structure.lux @@ -13,7 +13,7 @@ [complex (.only Variant Tuple)]] ["[1][0]" synthesis (.only Synthesis)] ["//[1]" /// - ["[1][0]" phase ("[1]#[0]" monad)]]]]) + ["[1][0]" phase (.open: "[1]#[0]" monad)]]]]) (def: .public (tuple generate archive elemsS+) (Generator (Tuple Synthesis)) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme.lux index 3e9b76aa3..061a5c26c 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme.lux @@ -23,7 +23,7 @@ [analysis (.only)] ["[1][0]" synthesis] ["//[1]" /// - ["[1][0]" phase ("[1]#[0]" monad)] + ["[1][0]" phase (.open: "[1]#[0]" monad)] [reference (.only) [variable (.only)]]]]]]]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/case.lux index d111d7349..0c5465e96 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/case.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/case.lux @@ -8,7 +8,7 @@ ["[0]" text (.only) ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" functor mix)] + ["[0]" list (.open: "[1]#[0]" functor mix)] ["[0]" set]]] [macro ["^" pattern] @@ -33,7 +33,7 @@ ["//[1]" /// [reference ["[1][0]" variable (.only Register)]] - ["[1][0]" phase ("[1]#[0]" monad)] + ["[1][0]" phase (.open: "[1]#[0]" monad)] [meta [archive (.only Archive)]]]]]]]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/extension/common.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/extension/common.lux index fe13c1aa2..f74911bc3 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/extension/common.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/extension/common.lux @@ -13,7 +13,7 @@ [number (.only hex) ["f" frac]] [collection - ["[0]" list ("[1]#[0]" functor)] + ["[0]" list (.open: "[1]#[0]" functor)] ["dict" dictionary (.only Dictionary)]]] ["[0]" macro (.only with_symbols) ["[0]" code] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/function.lux index baf83633b..c937c11e7 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/function.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/function.lux @@ -10,7 +10,7 @@ ["[0]" text (.only) ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" functor)]]] + ["[0]" list (.open: "[1]#[0]" functor)]]] [target ["_" scheme (.only Expression Computation Var)]]]] ["[0]" // @@ -25,7 +25,7 @@ ["[1][0]" generation (.only Context)] ["//[1]" /// [arity (.only Arity)] - ["[1][0]" phase ("[1]#[0]" monad)] + ["[1][0]" phase (.open: "[1]#[0]" monad)] [reference [variable (.only Register Variable)]]]]]]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/loop.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/loop.lux index 0f7a9c50a..6796a3944 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/loop.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/loop.lux @@ -8,7 +8,7 @@ ["[0]" text (.only) ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" functor)] + ["[0]" list (.open: "[1]#[0]" functor)] ["[0]" set (.only Set)]]] [math [number 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 c60d67bd1..94b77f919 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 @@ -10,12 +10,12 @@ ["<[0]>" code]]] [data ["[0]" product] - ["[0]" text ("[1]#[0]" hash) + ["[0]" text (.open: "[1]#[0]" hash) ["%" format (.only format)] [encoding ["[0]" utf8]]] [collection - ["[0]" list ("[1]#[0]" functor)] + ["[0]" list (.open: "[1]#[0]" functor)] ["[0]" sequence]]] ["[0]" macro (.only) [syntax (.only syntax:)] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/structure.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/structure.lux index 2c90b2010..ec1611ddf 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/structure.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/structure.lux @@ -15,7 +15,7 @@ [analysis (.only Variant Tuple)] ["[1][0]" synthesis (.only Synthesis)] ["//[1]" /// - ["[1][0]" phase ("[1]#[0]" monad)]]]]) + ["[1][0]" phase (.open: "[1]#[0]" monad)]]]]) (def: .public (tuple expression archive elemsS+) (Generator (Tuple Synthesis)) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis.lux index 0600ba9c0..99db4589b 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis.lux @@ -8,7 +8,7 @@ ["[0]" try]] [data [collection - ["[0]" list ("[1]#[0]" functor)] + ["[0]" list (.open: "[1]#[0]" functor)] ["[0]" dictionary (.only Dictionary)]]] [macro ["^" pattern]]]] @@ -25,7 +25,7 @@ ["[2][0]" simple] ["[2][0]" complex]] [/// - ["[0]" phase ("[1]#[0]" monad)] + ["[0]" phase (.open: "[1]#[0]" monad)] [reference (.only) [variable (.only)]]]]]]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/case.lux index 5890ab241..bdbcdeb02 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/case.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/case.lux @@ -8,10 +8,10 @@ ["[0]" pipe]] [data ["[0]" product] - ["[0]" bit ("[1]#[0]" equivalence)] - ["[0]" text ("[1]#[0]" equivalence)] + ["[0]" bit (.open: "[1]#[0]" equivalence)] + ["[0]" text (.open: "[1]#[0]" equivalence)] [collection - ["[0]" list ("[1]#[0]" functor mix monoid)] + ["[0]" list (.open: "[1]#[0]" functor mix monoid)] ["[0]" set (.only Set)]]] [macro ["^" pattern]] @@ -31,7 +31,7 @@ ["[2][0]" side] ["[2][0]" member (.only Member)]]] [/// - ["[1]" phase ("[1]#[0]" monad)] + ["[1]" phase (.open: "[1]#[0]" monad)] ["[1][0]" reference (.only) ["[1]/[0]" variable (.only Register Variable)]] [meta diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/function.lux index f1e08702f..dec9a0177 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/function.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/function.lux @@ -6,13 +6,13 @@ ["[0]" enum]] [control ["[0]" pipe] - ["[0]" maybe ("[1]#[0]" functor)] + ["[0]" maybe (.open: "[1]#[0]" functor)] ["[0]" exception (.only exception:)]] [data [text ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" functor monoid)]]] + ["[0]" list (.open: "[1]#[0]" functor monoid)]]] [macro ["^" pattern]] [math @@ -26,7 +26,7 @@ ["/" synthesis (.only Path Abstraction Synthesis Operation Phase)] [/// [arity (.only Arity)] - ["[0]" phase ("[1]#[0]" monad)] + ["[0]" phase (.open: "[1]#[0]" monad)] ["[1][0]" reference (.only) ["[1]/[0]" variable (.only Register Variable)]]]]]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/loop.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/loop.lux index e8388ed17..b3cb4d704 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/loop.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/loop.lux @@ -4,7 +4,7 @@ [abstract ["[0]" monad (.only do)]] [control - ["[0]" maybe ("[1]#[0]" monad)]] + ["[0]" maybe (.open: "[1]#[0]" monad)]] [data [collection ["[0]" list]]] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/variable.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/variable.lux index f774ddb6d..584612bbb 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/variable.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/synthesis/variable.lux @@ -4,7 +4,7 @@ [abstract ["[0]" monad (.only do)]] [control - ["[0]" maybe ("[1]#[0]" functor)] + ["[0]" maybe (.open: "[1]#[0]" functor)] ["[0]" try (.only Try)] ["[0]" exception (.only exception:)]] [data @@ -13,7 +13,7 @@ ["%" format]] [collection ["[0]" dictionary (.only Dictionary)] - ["[0]" list ("[1]#[0]" functor mix)] + ["[0]" list (.open: "[1]#[0]" functor mix)] ["[0]" set]]] [macro ["^" pattern]] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/program.lux b/stdlib/source/library/lux/tool/compiler/language/lux/program.lux index 30276425b..11d63955b 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/program.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/program.lux @@ -12,7 +12,7 @@ [text ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" functor)]]]]] + ["[0]" list (.open: "[1]#[0]" functor)]]]]] [//// [meta ["[0]" archive (.only Archive) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/synthesis.lux b/stdlib/source/library/lux/tool/compiler/language/lux/synthesis.lux index fbc202680..d1cad0503 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/synthesis.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/synthesis.lux @@ -11,11 +11,11 @@ [data ["[0]" sum] ["[0]" product] - ["[0]" bit ("[1]#[0]" equivalence)] - ["[0]" text ("[1]#[0]" equivalence) + ["[0]" bit (.open: "[1]#[0]" equivalence)] + ["[0]" text (.open: "[1]#[0]" equivalence) ["%" format (.only Format format)]] [collection - ["[0]" list ("[1]#[0]" functor)] + ["[0]" list (.open: "[1]#[0]" functor)] ["[0]" dictionary (.only Dictionary)]]] [macro ["^" pattern]] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/synthesis/simple.lux b/stdlib/source/library/lux/tool/compiler/language/lux/synthesis/simple.lux index f925aa95c..17419d58f 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/synthesis/simple.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/synthesis/simple.lux @@ -7,14 +7,14 @@ [control ["[0]" pipe]] [data - ["[0]" bit ("[1]#[0]" equivalence)] - ["[0]" text ("[1]#[0]" equivalence) + ["[0]" bit (.open: "[1]#[0]" equivalence)] + ["[0]" text (.open: "[1]#[0]" equivalence) ["%" format]]] [macro ["^" pattern]] [math [number - ["[0]" i64 ("[1]#[0]" equivalence)] + ["[0]" i64 (.open: "[1]#[0]" equivalence)] ["n" nat] ["i" int] ["f" frac]]]]]) diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive.lux b/stdlib/source/library/lux/tool/compiler/meta/archive.lux index 41d12fdc2..b88b57053 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive.lux @@ -19,13 +19,13 @@ [format ["[0]" binary (.only Writer)]] [collection - ["[0]" list ("[1]#[0]" functor mix)] + ["[0]" list (.open: "[1]#[0]" functor mix)] ["[0]" dictionary (.only Dictionary)] ["[0]" set] ["[0]" sequence (.only Sequence)]]] [math [number - ["n" nat ("[1]#[0]" equivalence)]]] + ["n" nat (.open: "[1]#[0]" equivalence)]]] [type [primitive (.except)]]]] [/ diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive/artifact/category.lux b/stdlib/source/library/lux/tool/compiler/meta/archive/artifact/category.lux index 085e3d001..146b2d12d 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive/artifact/category.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive/artifact/category.lux @@ -7,7 +7,7 @@ ["[0]" maybe]] [data ["[0]" product] - ["[0]" text ("[1]#[0]" equivalence)]] + ["[0]" text (.open: "[1]#[0]" equivalence)]] [macro ["^" pattern]] [math diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive/module/document.lux b/stdlib/source/library/lux/tool/compiler/meta/archive/module/document.lux index 7daff5d95..7f0f4faeb 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive/module/document.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive/module/document.lux @@ -16,7 +16,7 @@ [type (.only sharing) [primitive (.except)]]]] [/// - ["[0]" signature (.only Signature) ("[1]#[0]" equivalence)] + ["[0]" signature (.only Signature) (.open: "[1]#[0]" equivalence)] ["[0]" key (.only Key)]]) (exception: .public (invalid_signature [expected Signature diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive/registry.lux b/stdlib/source/library/lux/tool/compiler/meta/archive/registry.lux index 56586bd2e..3b849a479 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive/registry.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive/registry.lux @@ -5,7 +5,7 @@ [monad (.only do)]] [control ["[0]" pipe] - ["[0]" maybe ("[1]#[0]" functor)] + ["[0]" maybe (.open: "[1]#[0]" functor)] ["[0]" exception (.only exception:)] ["<>" parser (.only) ["<[0]>" binary (.only Parser)]]] @@ -16,7 +16,7 @@ [collection [set (.only Set)] ["[0]" list] - ["[0]" sequence (.only Sequence) ("[1]#[0]" functor mix)] + ["[0]" sequence (.only Sequence) (.open: "[1]#[0]" functor mix)] ["[0]" dictionary (.only Dictionary)]] [format ["[0]" binary (.only Writer)]]] diff --git a/stdlib/source/library/lux/tool/compiler/meta/cache/dependency/artifact.lux b/stdlib/source/library/lux/tool/compiler/meta/cache/dependency/artifact.lux index 18a6165f6..8008fe5a6 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/cache/dependency/artifact.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/cache/dependency/artifact.lux @@ -8,7 +8,7 @@ [data ["[0]" product] [collection - ["[0]" list ("[1]#[0]" monoid mix monad)] + ["[0]" list (.open: "[1]#[0]" monoid mix monad)] ["[0]" set (.only Set)] ["[0]" dictionary (.only Dictionary)] ["[0]" sequence]]] diff --git a/stdlib/source/library/lux/tool/compiler/meta/cache/dependency/module.lux b/stdlib/source/library/lux/tool/compiler/meta/cache/dependency/module.lux index fb2fa3ab8..b1d64ebb5 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/cache/dependency/module.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/cache/dependency/module.lux @@ -4,7 +4,7 @@ [abstract ["[0]" monad (.only do)]] [control - ["[0]" maybe ("[1]#[0]" functor)] + ["[0]" maybe (.open: "[1]#[0]" functor)] ["[0]" try (.only Try)] ["[0]" state] [function @@ -13,7 +13,7 @@ ["[0]" text (.only) ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" functor mix)] + ["[0]" list (.open: "[1]#[0]" functor mix)] ["[0]" dictionary (.only Dictionary)] ["[0]" set (.only Set)]]]]] [//// diff --git a/stdlib/source/library/lux/tool/compiler/meta/cache/module.lux b/stdlib/source/library/lux/tool/compiler/meta/cache/module.lux index 35cb42cac..9a4ed2e1b 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/cache/module.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/cache/module.lux @@ -11,10 +11,10 @@ [data [binary (.only Binary)] ["[0]" product] - ["[0]" text ("[1]#[0]" equivalence) + ["[0]" text (.open: "[1]#[0]" equivalence) ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" functor)] + ["[0]" list (.open: "[1]#[0]" functor)] ["[0]" dictionary (.only Dictionary)]]] [world ["[0]" file]]]] diff --git a/stdlib/source/library/lux/tool/compiler/meta/cache/purge.lux b/stdlib/source/library/lux/tool/compiler/meta/cache/purge.lux index 8cb425843..6ccdcdd56 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/cache/purge.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/cache/purge.lux @@ -5,13 +5,13 @@ [predicate (.only Predicate)] ["[0]" monad (.only Monad do)]] [control - ["[0]" try (.only Try) ("[1]#[0]" functor)] + ["[0]" try (.only Try) (.open: "[1]#[0]" functor)] [concurrency ["[0]" async (.only Async)]]] [data - ["[0]" text ("[1]#[0]" equivalence)] + ["[0]" text (.open: "[1]#[0]" equivalence)] [collection - ["[0]" list ("[1]#[0]" mix functor)] + ["[0]" list (.open: "[1]#[0]" mix functor)] ["[0]" dictionary (.only Dictionary)] ["[0]" set]]] [math diff --git a/stdlib/source/library/lux/tool/compiler/meta/cli.lux b/stdlib/source/library/lux/tool/compiler/meta/cli.lux index a3e631d17..d611dde33 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/cli.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/cli.lux @@ -14,7 +14,7 @@ ["[0]" text (.only) ["%" format]] [collection - ["[0]" list ("[1]#[0]" functor)]]] + ["[0]" list (.open: "[1]#[0]" functor)]]] [macro ["^" pattern]] [math diff --git a/stdlib/source/library/lux/tool/compiler/meta/cli/compiler.lux b/stdlib/source/library/lux/tool/compiler/meta/cli/compiler.lux index bdd1e8714..1d37314b6 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/cli/compiler.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/cli/compiler.lux @@ -12,7 +12,7 @@ ["[0]" text (.only) ["%" format]] [collection - ["[0]" list ("[1]#[0]" functor)]]] + ["[0]" list (.open: "[1]#[0]" functor)]]] [math [number (.only hex)]] [meta diff --git a/stdlib/source/library/lux/tool/compiler/meta/export.lux b/stdlib/source/library/lux/tool/compiler/meta/export.lux index e5391b566..21c75e46c 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/export.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/export.lux @@ -4,9 +4,9 @@ [abstract ["[0]" monad (.only do)]] [control - ["[0]" try (.only Try) ("[1]#[0]" monad)] + ["[0]" try (.only Try) (.open: "[1]#[0]" monad)] [concurrency - ["[0]" async (.only Async) ("[1]#[0]" functor)]]] + ["[0]" async (.only Async) (.open: "[1]#[0]" functor)]]] [data ["[0]" text (.only) ["%" format (.only format)]] 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 d5aadcdd9..435a8d3fb 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux @@ -7,17 +7,17 @@ [control ["[0]" try (.only Try)] [concurrency - ["[0]" async (.only Async) ("[1]#[0]" monad)]] + ["[0]" async (.only Async) (.open: "[1]#[0]" monad)]] ["<>" parser (.only) ["<[0]>" binary (.only Parser)]]] [data [binary (.only Binary)] ["[0]" product] - ["[0]" text ("[1]#[0]" equivalence) + ["[0]" text (.open: "[1]#[0]" equivalence) ["%" format (.only format)]] [collection [set (.only Set)] - ["[0]" list ("[1]#[0]" mix)] + ["[0]" list (.open: "[1]#[0]" mix)] ["[0]" dictionary (.only Dictionary)] ["[0]" sequence (.only Sequence)]]] [macro 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 06c7fb4f8..96e91fbd6 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/io/context.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/io/context.lux @@ -10,10 +10,10 @@ ["[0]" try (.only Try)] ["[0]" exception (.only exception:)] [concurrency - ["[0]" async (.only Async) ("[1]#[0]" monad)]]] + ["[0]" async (.only Async) (.open: "[1]#[0]" monad)]]] [data [binary (.only Binary)] - ["[0]" text ("[1]#[0]" hash) + ["[0]" text (.open: "[1]#[0]" hash) ["%" format (.only format)] [encoding ["[0]" utf8]]] diff --git a/stdlib/source/library/lux/tool/compiler/meta/packager.lux b/stdlib/source/library/lux/tool/compiler/meta/packager.lux index a45d43772..1543e082f 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/packager.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/packager.lux @@ -9,7 +9,7 @@ [collection [dictionary (.only Dictionary)] ["[0]" sequence] - ["[0]" list ("[1]#[0]" functor)]]] + ["[0]" list (.open: "[1]#[0]" functor)]]] [world ["[0]" file]]]] [// 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 197d404b8..63df754f0 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux @@ -5,7 +5,7 @@ [abstract ["[0]" monad (.only Monad do)]] [control - ["[0]" maybe ("[1]#[0]" functor)] + ["[0]" maybe (.open: "[1]#[0]" functor)] ["[0]" try (.only Try)]] [data ["[0]" binary (.only Binary)] @@ -13,7 +13,7 @@ ["%" format (.only format)]] [collection ["[0]" sequence] - ["[0]" list ("[1]#[0]" functor)] + ["[0]" list (.open: "[1]#[0]" functor)] ["[0]" dictionary] ["[0]" set (.only Set)]]] [math diff --git a/stdlib/source/library/lux/tool/compiler/meta/packager/ruby.lux b/stdlib/source/library/lux/tool/compiler/meta/packager/ruby.lux index a1b7bb6a3..1fbd7ddc9 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/packager/ruby.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/packager/ruby.lux @@ -15,7 +15,7 @@ ["[0]" utf8]]] [collection ["[0]" sequence] - ["[0]" list ("[1]#[0]" functor mix)] + ["[0]" list (.open: "[1]#[0]" functor mix)] ["[0]" dictionary (.only Dictionary)] ["[0]" set (.only Set)]]] [math diff --git a/stdlib/source/library/lux/tool/compiler/meta/packager/scheme.lux b/stdlib/source/library/lux/tool/compiler/meta/packager/scheme.lux index 5c6ba160e..d99635b00 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/packager/scheme.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/packager/scheme.lux @@ -14,7 +14,7 @@ ["[0]" encoding]] [collection ["[0]" sequence] - ["[0]" list ("[1]#[0]" functor mix)] + ["[0]" list (.open: "[1]#[0]" functor mix)] ["[0]" dictionary (.only Dictionary)] ["[0]" set]] [format diff --git a/stdlib/source/library/lux/tool/compiler/meta/packager/script.lux b/stdlib/source/library/lux/tool/compiler/meta/packager/script.lux index 4503723f9..9c140909d 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/packager/script.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/packager/script.lux @@ -16,7 +16,7 @@ [collection ["[0]" sequence] ["[0]" set (.only Set)] - ["[0]" list ("[1]#[0]" functor)]]]]] + ["[0]" list (.open: "[1]#[0]" functor)]]]]] ["[0]" // (.only Packager) [// ["[0]" archive (.only Output) diff --git a/stdlib/source/library/lux/tool/compiler/phase.lux b/stdlib/source/library/lux/tool/compiler/phase.lux index 35e8215f6..213d40339 100644 --- a/stdlib/source/library/lux/tool/compiler/phase.lux +++ b/stdlib/source/library/lux/tool/compiler/phase.lux @@ -6,7 +6,7 @@ [monad (.only Monad do)]] [control ["[0]" state] - ["[0]" try (.only Try) ("[1]#[0]" functor)] + ["[0]" try (.only Try) (.open: "[1]#[0]" functor)] ["[0]" exception (.only Exception)] ["[0]" io]] [data diff --git a/stdlib/source/library/lux/tool/interpreter.lux b/stdlib/source/library/lux/tool/interpreter.lux index 74d9a49f1..07405ea54 100644 --- a/stdlib/source/library/lux/tool/interpreter.lux +++ b/stdlib/source/library/lux/tool/interpreter.lux @@ -6,7 +6,7 @@ ["[0]" try (.only Try)] ["ex" exception (.only exception:)]] [data - ["[0]" text ("[1]#[0]" equivalence) + ["[0]" text (.open: "[1]#[0]" equivalence) ["%" format (.only format)]]] [type (.only sharing) ["[0]" check]] diff --git a/stdlib/source/library/lux/type.lux b/stdlib/source/library/lux/type.lux index 879334883..6976a1df0 100644 --- a/stdlib/source/library/lux/type.lux +++ b/stdlib/source/library/lux/type.lux @@ -13,20 +13,20 @@ ["<[0]>" code (.only Parser)]]] [data ["[0]" product] - ["[0]" text ("[1]#[0]" monoid equivalence)] + ["[0]" text (.open: "[1]#[0]" monoid equivalence)] [collection ["[0]" array] - ["[0]" list ("[1]#[0]" monad monoid mix)]]] + ["[0]" list (.open: "[1]#[0]" monad monoid mix)]]] ["[0]" macro (.only) [syntax (.only syntax:)] ["^" pattern] ["[0]" code]] [math [number - ["n" nat ("[1]#[0]" decimal)]]] + ["n" nat (.open: "[1]#[0]" decimal)]]] ["[0]" meta (.only) ["[0]" location] - ["[0]" symbol ("[1]#[0]" equivalence codec)]]]]) + ["[0]" symbol (.open: "[1]#[0]" equivalence codec)]]]]) (template [<name> <tag>] [(def: .public (<name> type) diff --git a/stdlib/source/library/lux/type/check.lux b/stdlib/source/library/lux/type/check.lux index e61b0fb11..a98b54932 100644 --- a/stdlib/source/library/lux/type/check.lux +++ b/stdlib/source/library/lux/type/check.lux @@ -12,16 +12,16 @@ ["[0]" exception (.only Exception exception:)]] [data ["[0]" product] - ["[0]" text ("[1]#[0]" monoid equivalence)] + ["[0]" text (.open: "[1]#[0]" monoid equivalence)] [collection - ["[0]" list ("[1]#[0]" mix)] + ["[0]" list (.open: "[1]#[0]" mix)] ["[0]" set (.only Set)]]] [macro ["^" pattern]] [math [number - ["n" nat ("[1]#[0]" decimal)]]]]] - ["[0]" // ("[1]#[0]" equivalence)]) + ["n" nat (.open: "[1]#[0]" decimal)]]]]] + ["[0]" // (.open: "[1]#[0]" equivalence)]) (template: (!n#= reference subject) [("lux i64 =" reference subject)]) diff --git a/stdlib/source/library/lux/type/implicit.lux b/stdlib/source/library/lux/type/implicit.lux index e4fb1cac1..622e308ed 100644 --- a/stdlib/source/library/lux/type/implicit.lux +++ b/stdlib/source/library/lux/type/implicit.lux @@ -11,10 +11,10 @@ ["<[0]>" code (.only Parser)]]] [data ["[0]" product] - ["[0]" text ("[1]#[0]" equivalence) + ["[0]" text (.open: "[1]#[0]" equivalence) ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" monad mix)] + ["[0]" list (.open: "[1]#[0]" monad mix)] ["[0]" dictionary (.only Dictionary)]]] ["[0]" macro (.only) ["[0]" code] @@ -23,7 +23,7 @@ ["[0]" number (.only) ["n" nat]]] ["[0]" meta] - ["[0]" type ("[1]#[0]" equivalence) + ["[0]" type (.open: "[1]#[0]" equivalence) ["[0]" check (.only Check)]]]]) (def: (type_var id env) diff --git a/stdlib/source/library/lux/type/poly.lux b/stdlib/source/library/lux/type/poly.lux index a888e8e7e..cb18f9967 100644 --- a/stdlib/source/library/lux/type/poly.lux +++ b/stdlib/source/library/lux/type/poly.lux @@ -7,14 +7,14 @@ ["[0]" monad (.only do)]] [control ["[0]" maybe] - ["<>" parser ("[1]#[0]" monad) + ["<>" parser (.open: "[1]#[0]" monad) ["<[0]>" type (.only Env)] ["<[0]>" code (.only Parser)]]] [data ["[0]" product] ["[0]" text] [collection - ["[0]" list ("[1]#[0]" functor)] + ["[0]" list (.open: "[1]#[0]" functor)] ["[0]" dictionary]]] [macro (.only with_symbols) [syntax (.only syntax:)] diff --git a/stdlib/source/library/lux/type/primitive.lux b/stdlib/source/library/lux/type/primitive.lux index e45876b69..7486a56fc 100644 --- a/stdlib/source/library/lux/type/primitive.lux +++ b/stdlib/source/library/lux/type/primitive.lux @@ -6,19 +6,19 @@ [monad (.only Monad do)]] [control ["[0]" exception (.only exception:)] - ["<>" parser ("[1]#[0]" monad) + ["<>" parser (.open: "[1]#[0]" monad) ["<[0]>" code (.only Parser)]]] [data - ["[0]" text ("[1]#[0]" equivalence monoid)] + ["[0]" text (.open: "[1]#[0]" equivalence monoid)] [collection - ["[0]" list ("[1]#[0]" functor monoid)]]] + ["[0]" list (.open: "[1]#[0]" functor monoid)]]] [macro ["^" pattern] ["[0]" code] [syntax (.only syntax:) ["|[0]|" export]]] [meta - ["[0]" symbol ("[1]#[0]" codec)]]]] + ["[0]" symbol (.open: "[1]#[0]" codec)]]]] ["[0]" //]) (type: Stack diff --git a/stdlib/source/library/lux/type/resource.lux b/stdlib/source/library/lux/type/resource.lux index 57d52c9a8..f2365d0cf 100644 --- a/stdlib/source/library/lux/type/resource.lux +++ b/stdlib/source/library/lux/type/resource.lux @@ -16,7 +16,7 @@ [collection ["[0]" set] ["[0]" sequence (.only Sequence)] - ["[0]" list ("[1]#[0]" functor mix)]]] + ["[0]" list (.open: "[1]#[0]" functor mix)]]] ["[0]" macro (.only) [syntax (.only syntax:)]] [math diff --git a/stdlib/source/library/lux/type/unit.lux b/stdlib/source/library/lux/type/unit.lux index 91942f05c..317dc1848 100644 --- a/stdlib/source/library/lux/type/unit.lux +++ b/stdlib/source/library/lux/type/unit.lux @@ -8,7 +8,7 @@ [order (.only Order)] [enum (.only Enum)]] [control - ["<>" parser ("[1]#[0]" monad) + ["<>" parser (.open: "[1]#[0]" monad) ["<[0]>" code (.only Parser)]]] [data ["[0]" text (.only) diff --git a/stdlib/source/library/lux/world/console.lux b/stdlib/source/library/lux/world/console.lux index a6b0d4668..b1d7dac13 100644 --- a/stdlib/source/library/lux/world/console.lux +++ b/stdlib/source/library/lux/world/console.lux @@ -7,11 +7,11 @@ [monad (.only do)]] [control ["[0]" maybe] - ["[0]" try (.only Try) ("[1]#[0]" functor)] + ["[0]" try (.only Try) (.open: "[1]#[0]" functor)] ["[0]" exception (.only exception:)] - ["[0]" io (.only IO io) ("[1]#[0]" functor)] + ["[0]" io (.only IO io) (.open: "[1]#[0]" functor)] [concurrency - ["[0]" async (.only Async) ("[1]#[0]" monad)] + ["[0]" async (.only Async) (.open: "[1]#[0]" monad)] ["[0]" atom]]] [data ["[0]" text (.only Char) diff --git a/stdlib/source/library/lux/world/db/jdbc.lux b/stdlib/source/library/lux/world/db/jdbc.lux index 6942f788a..c8d453d53 100644 --- a/stdlib/source/library/lux/world/db/jdbc.lux +++ b/stdlib/source/library/lux/world/db/jdbc.lux @@ -8,7 +8,7 @@ ["[0]" try (.only Try)] ["ex" exception] [concurrency - ["[0]" async (.only Async) ("[1]#[0]" monad)]] + ["[0]" async (.only Async) (.open: "[1]#[0]" monad)]] [security ["!" capability (.only capability:)]]] [data diff --git a/stdlib/source/library/lux/world/db/sql.lux b/stdlib/source/library/lux/world/db/sql.lux index 2706dd6a4..084ef671f 100644 --- a/stdlib/source/library/lux/world/db/sql.lux +++ b/stdlib/source/library/lux/world/db/sql.lux @@ -6,10 +6,10 @@ [data [number ["i" int]] - ["[0]" text ("[1]#[0]" equivalence) + ["[0]" text (.open: "[1]#[0]" equivalence) ["%" format (.only format)]] [collection - ["[0]" list ("[1]#[0]" functor)]]] + ["[0]" list (.open: "[1]#[0]" functor)]]] [macro ["[0]" template]] [type diff --git a/stdlib/source/library/lux/world/file.lux b/stdlib/source/library/lux/world/file.lux index 93a3879ac..f03256f14 100644 --- a/stdlib/source/library/lux/world/file.lux +++ b/stdlib/source/library/lux/world/file.lux @@ -6,23 +6,23 @@ ["[0]" monad (.only Monad do)]] [control ["[0]" pipe] - ["[0]" maybe ("[1]#[0]" functor)] - ["[0]" try (.only Try) ("[1]#[0]" functor)] + ["[0]" maybe (.open: "[1]#[0]" functor)] + ["[0]" try (.only Try) (.open: "[1]#[0]" functor)] ["[0]" exception (.only exception:)] - ["[0]" io (.only IO) ("[1]#[0]" functor)] + ["[0]" io (.only IO) (.open: "[1]#[0]" functor)] ["[0]" function] [concurrency ["[0]" async (.only Async)] ["[0]" stm (.only Var STM)]]] [data - ["[0]" bit ("[1]#[0]" equivalence)] + ["[0]" bit (.open: "[1]#[0]" equivalence)] ["[0]" product] ["[0]" binary (.only Binary)] - ["[0]" text ("[1]#[0]" equivalence) + ["[0]" text (.open: "[1]#[0]" equivalence) ["%" format (.only format)]] [collection ["[0]" array (.only Array)] - ["[0]" list ("[1]#[0]" functor)] + ["[0]" list (.open: "[1]#[0]" functor)] ["[0]" dictionary (.only Dictionary)]]] ["[0]" ffi (~~ (.for "JavaScript" (~~ (.these ["[0]" node_js])) diff --git a/stdlib/source/library/lux/world/file/watch.lux b/stdlib/source/library/lux/world/file/watch.lux index 60e01ebc6..a3026e8e8 100644 --- a/stdlib/source/library/lux/world/file/watch.lux +++ b/stdlib/source/library/lux/world/file/watch.lux @@ -20,14 +20,14 @@ ["%" format (.only format)]] [collection ["[0]" dictionary (.only Dictionary)] - ["[0]" list ("[1]#[0]" functor monoid mix)] + ["[0]" list (.open: "[1]#[0]" functor monoid mix)] ["[0]" set] ["[0]" array]]] [math [number ["n" nat]]] [time - ["[0]" instant (.only Instant) ("[1]#[0]" equivalence)]] + ["[0]" instant (.only Instant) (.open: "[1]#[0]" equivalence)]] [type [primitive (.only primitive: representation abstraction)]]]] ["[0]" //]) diff --git a/stdlib/source/library/lux/world/net/http/client.lux b/stdlib/source/library/lux/world/net/http/client.lux index 49ead2fd3..7f0a1588f 100644 --- a/stdlib/source/library/lux/world/net/http/client.lux +++ b/stdlib/source/library/lux/world/net/http/client.lux @@ -8,7 +8,7 @@ [control ["[0]" pipe] ["[0]" io (.only IO)] - ["[0]" maybe ("[1]#[0]" functor)] + ["[0]" maybe (.open: "[1]#[0]" functor)] ["[0]" try (.only Try)] [concurrency ["[0]" async (.only Async)]] diff --git a/stdlib/source/library/lux/world/net/http/cookie.lux b/stdlib/source/library/lux/world/net/http/cookie.lux index 60fe0989a..bb09b61ee 100644 --- a/stdlib/source/library/lux/world/net/http/cookie.lux +++ b/stdlib/source/library/lux/world/net/http/cookie.lux @@ -4,7 +4,7 @@ [control [monad (.only do)] ["[0]" try (.only Try)] - ["p" parser ("[1]#[0]" monad) + ["p" parser (.open: "[1]#[0]" monad) ["l" text (.only Parser)]]] [data [number diff --git a/stdlib/source/library/lux/world/net/http/request.lux b/stdlib/source/library/lux/world/net/http/request.lux index 6c6325eb6..86d74217d 100644 --- a/stdlib/source/library/lux/world/net/http/request.lux +++ b/stdlib/source/library/lux/world/net/http/request.lux @@ -20,7 +20,7 @@ ["[0]" json (.only JSON)] ["[0]" context (.only Context Property)]] [collection - ["[0]" list ("[1]#[0]" functor mix)] + ["[0]" list (.open: "[1]#[0]" functor mix)] ["[0]" dictionary]]] [macro ["^" pattern]] diff --git a/stdlib/source/library/lux/world/net/http/response.lux b/stdlib/source/library/lux/world/net/http/response.lux index ed50b5f08..4e4542dde 100644 --- a/stdlib/source/library/lux/world/net/http/response.lux +++ b/stdlib/source/library/lux/world/net/http/response.lux @@ -4,7 +4,7 @@ [control [concurrency ["[0]" async] - ["[0]" frp ("[1]#[0]" monad)]]] + ["[0]" frp (.open: "[1]#[0]" monad)]]] [data ["[0]" text ["[0]" encoding]] @@ -12,7 +12,7 @@ ["[0]" html] ["[0]" css (.only CSS)] ["[0]" context] - ["[0]" json (.only JSON) ("[1]#[0]" codec)]]] + ["[0]" json (.only JSON) (.open: "[1]#[0]" codec)]]] ["[0]" io] [world ["[0]" binary (.only Binary)]]]] diff --git a/stdlib/source/library/lux/world/program.lux b/stdlib/source/library/lux/world/program.lux index 90000b855..c78116cbe 100644 --- a/stdlib/source/library/lux/world/program.lux +++ b/stdlib/source/library/lux/world/program.lux @@ -7,7 +7,7 @@ [control ["[0]" function] ["[0]" io (.only IO)] - ["[0]" maybe ("[1]#[0]" functor)] + ["[0]" maybe (.open: "[1]#[0]" functor)] ["[0]" try (.only Try)] ["[0]" exception (.only exception:)] [concurrency @@ -16,13 +16,13 @@ [parser ["[0]" environment (.only Environment)]]] [data - ["[0]" bit ("[1]#[0]" equivalence)] + ["[0]" bit (.open: "[1]#[0]" equivalence)] ["[0]" text (.only) ["%" format (.only format)]] [collection ["[0]" array (.only Array)] ["[0]" dictionary (.only Dictionary)] - ["[0]" list ("[1]#[0]" functor)]]] + ["[0]" list (.open: "[1]#[0]" functor)]]] ["[0]" ffi (.only import:) (~~ (.for "JavaScript" (~~ (.these ["[0]" node_js])) "{old}" (~~ (.these ["node_js" //math])) diff --git a/stdlib/source/library/lux/world/shell.lux b/stdlib/source/library/lux/world/shell.lux index be59e7b65..e52d4e0f3 100644 --- a/stdlib/source/library/lux/world/shell.lux +++ b/stdlib/source/library/lux/world/shell.lux @@ -25,7 +25,7 @@ ["[0]" utf8]]] [collection ["[0]" array (.only Array)] - ["[0]" list ("[1]#[0]" mix functor)] + ["[0]" list (.open: "[1]#[0]" mix functor)] ["[0]" dictionary]]] [math [number (.only hex) |