From 9e7ddacf853efd7a18c1911d2f287d483b083229 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 3 Jul 2022 00:35:32 -0400 Subject: Added a new custom type for pattern-matching macros. --- stdlib/source/library/lux.lux | 567 +++++++++++---------- stdlib/source/library/lux/abstract/comonad.lux | 4 +- stdlib/source/library/lux/abstract/monad.lux | 4 +- stdlib/source/library/lux/control/maybe.lux | 4 +- stdlib/source/library/lux/control/pipe.lux | 2 +- stdlib/source/library/lux/control/try.lux | 4 +- stdlib/source/library/lux/data/collection/list.lux | 10 +- .../source/library/lux/data/collection/queue.lux | 6 +- .../source/library/lux/data/collection/stream.lux | 23 +- stdlib/source/library/lux/data/format/tar.lux | 4 +- stdlib/source/library/lux/data/format/xml.lux | 2 +- stdlib/source/library/lux/data/text.lux | 6 +- stdlib/source/library/lux/data/text/escape.lux | 10 +- stdlib/source/library/lux/data/text/regex.lux | 19 +- stdlib/source/library/lux/documentation.lux | 10 +- stdlib/source/library/lux/ffi.lux | 8 +- stdlib/source/library/lux/ffi.old.lux | 2 +- stdlib/source/library/lux/math.lux | 6 +- stdlib/source/library/lux/math/number/frac.lux | 6 +- stdlib/source/library/lux/math/number/int.lux | 4 +- stdlib/source/library/lux/math/number/nat.lux | 47 +- stdlib/source/library/lux/math/number/rev.lux | 2 +- stdlib/source/library/lux/meta/macro.lux | 12 +- stdlib/source/library/lux/meta/macro/pattern.lux | 226 ++++---- stdlib/source/library/lux/meta/symbol.lux | 4 +- stdlib/source/library/lux/meta/type.lux | 2 +- stdlib/source/library/lux/meta/type/check.lux | 12 +- .../source/library/lux/target/jvm/reflection.lux | 2 +- stdlib/source/library/lux/time/day.lux | 2 +- stdlib/source/library/lux/time/month.lux | 2 +- .../lux/tool/compiler/language/lux/analysis.lux | 2 +- .../compiler/language/lux/analysis/coverage.lux | 5 +- .../compiler/language/lux/analysis/inference.lux | 2 +- .../tool/compiler/language/lux/analysis/macro.lux | 2 +- .../compiler/language/lux/analysis/pattern.lux | 2 +- .../tool/compiler/language/lux/phase/analysis.lux | 6 +- .../compiler/language/lux/phase/analysis/case.lux | 10 +- .../language/lux/phase/analysis/complex.lux | 10 +- .../compiler/language/lux/phase/declaration.lux | 8 +- .../language/lux/phase/extension/analysis/jvm.lux | 36 +- .../language/lux/phase/extension/analysis/lux.lux | 8 +- .../lux/phase/extension/declaration/lux.lux | 14 +- .../lux/phase/extension/generation/js/common.lux | 18 +- .../lux/phase/extension/generation/jvm/host.lux | 36 +- .../lux/phase/extension/generation/lua/common.lux | 18 +- .../phase/extension/generation/python/common.lux | 10 +- .../lux/phase/extension/generation/ruby/common.lux | 10 +- .../language/lux/phase/generation/common_lisp.lux | 4 +- .../lux/phase/generation/common_lisp/case.lux | 16 +- .../language/lux/phase/generation/extension.lux | 2 +- .../compiler/language/lux/phase/generation/js.lux | 24 +- .../language/lux/phase/generation/js/case.lux | 26 +- .../language/lux/phase/generation/js/loop.lux | 4 +- .../compiler/language/lux/phase/generation/jvm.lux | 24 +- .../language/lux/phase/generation/jvm/case.lux | 10 +- .../language/lux/phase/generation/jvm/function.lux | 2 +- .../language/lux/phase/generation/jvm/loop.lux | 2 +- .../compiler/language/lux/phase/generation/lua.lux | 24 +- .../language/lux/phase/generation/lua/case.lux | 12 +- .../compiler/language/lux/phase/generation/php.lux | 18 +- .../language/lux/phase/generation/php/case.lux | 14 +- .../language/lux/phase/generation/python.lux | 8 +- .../language/lux/phase/generation/python/case.lux | 16 +- .../compiler/language/lux/phase/generation/r.lux | 4 +- .../language/lux/phase/generation/r/case.lux | 10 +- .../lux/phase/generation/r/procedure/host.lux | 6 +- .../language/lux/phase/generation/ruby.lux | 8 +- .../language/lux/phase/generation/ruby/case.lux | 16 +- .../language/lux/phase/generation/scheme.lux | 4 +- .../language/lux/phase/generation/scheme/case.lux | 10 +- .../tool/compiler/language/lux/phase/synthesis.lux | 2 +- .../compiler/language/lux/phase/synthesis/case.lux | 64 +-- .../language/lux/phase/synthesis/function.lux | 12 +- .../compiler/language/lux/phase/synthesis/loop.lux | 32 +- .../lux/tool/compiler/reference/variable.lux | 2 +- 75 files changed, 823 insertions(+), 762 deletions(-) (limited to 'stdlib/source/library') diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux index 2e875d426..c13ce6ab0 100644 --- a/stdlib/source/library/lux.lux +++ b/stdlib/source/library/lux.lux @@ -1205,14 +1205,14 @@ (meta#in {#Item (list#mix |#Item| |#End| (list#reversed xs)) {#End}}))) -(def' .private partial_list +(def' .private list#partial Macro (macro (_ xs) ({{#Item last init} (meta#in (list (list#mix |#Item| last init))) _ - (failure "Wrong syntax for partial_list")} + (failure "Wrong syntax for list#partial")} (list#reversed xs)))) (def' .public Union @@ -1547,8 +1547,8 @@ (-> Text a ($' Property_List a) ($' Property_List a))) ({{#Item [k' v'] property_list'} (if (text#= k k') - (partial_list [k v] property_list') - (partial_list [k' v'] (property#with k v property_list'))) + (list#partial [k v] property_list') + (list#partial [k' v'] (property#with k v property_list'))) {#End} (list [k v])} @@ -1757,7 +1757,7 @@ (-> ($' List a) ($' List b) ($' List (Tuple a b)))) ({{#Item x xs'} ({{#Item y ys'} - (partial_list [x y] (zipped_2 xs' ys')) + (list#partial [x y] (zipped_2 xs' ys')) _ (list)} @@ -2426,7 +2426,7 @@ xs {#Item [x xs']} - (partial_list x sep (list#interposed sep xs'))} + (list#partial x sep (list#interposed sep xs'))} xs)) (def' .private (single_expansion token) @@ -2716,7 +2716,7 @@ ..#source source/pre ..#current_module current_module/pre ..#modules modules/pre - ..#scopes (partial_list [#name (list) + ..#scopes (list#partial [#name (list) #inner 0 #locals [#counter 0 #mappings (list [..quantification_level [.Nat ("lux type as" Nat -1)]])] @@ -2830,30 +2830,52 @@ (failure "Wrong syntax for exec")} (list#reversed tokens)))) +(def' .public Pattern + Type + {#Primitive "#Macro/Pattern" {#End}}) + +(def' .public (pattern it) + (-> Macro Pattern) + ("lux type as" Pattern it)) + +(def' .public (pattern_macro it) + (-> Pattern Macro') + ("lux type as" Macro' it)) + +(def' .private (case_expansion#macro case_expansion pattern body branches) + (type_literal (-> (-> (List Code) (Meta (List Code))) + Code Code (List Code) + (Meta (List Code)))) + (do meta#monad + [pattern (one_expansion (full_expansion #1 pattern)) + branches (case_expansion branches)] + (in (list#partial pattern body branches)))) + (def' .private (case_expansion branches) (type_literal (-> (List Code) (Meta (List Code)))) - ({{#Item [_ {#Form {#Item [_ {#Symbol name}] args}}] + ({{#Item [@composite {#Form {#Item [@symbol {#Symbol global}] parameters}}] {#Item body branches'}} (do meta#monad - [??? (macro? name)] - (if ??? - (do meta#monad - [init_expansion (single_expansion (form$ (partial_list (symbol$ name) (form$ args) body branches')))] - (case_expansion init_expansion)) - (do meta#monad - [sub_expansion (case_expansion branches')] - (in (partial_list (form$ (partial_list (symbol$ name) args)) - body - sub_expansion))))) + [|global| (..normal global) + ?type,value (global_value |global|)] + ({{#Some [type value]} + (if (type#= Pattern type) + (do meta#monad + [branches'' ((pattern_macro ("lux type as" Pattern value)) + (list#partial (form$ parameters) body branches'))] + (case_expansion branches'')) + (case_expansion#macro case_expansion [@composite {#Form {#Item [@symbol {#Symbol global}] parameters}}] body branches')) + + {#None} + (case_expansion#macro case_expansion [@composite {#Form {#Item [@symbol {#Symbol global}] parameters}}] body branches')} + ?type,value)) {#Item pattern {#Item body branches'}} - (do meta#monad - [sub_expansion (case_expansion branches')] - (in (partial_list pattern body sub_expansion))) + (case_expansion#macro case_expansion pattern body branches') {#End} - (do meta#monad [] (in (list))) + (meta#in (list)) _ (failure (all text#composite "'lux.case' expects an even number of tokens: " (|> branches @@ -2875,45 +2897,29 @@ (failure "Wrong syntax for case")} tokens))) -(def' .public pattern - Macro - (macro (_ tokens) - (case tokens - {#Item [_ {#Form {#Item pattern {#End}}}] {#Item body branches}} - (do meta#monad - [pattern+ (full_expansion #1 pattern)] - (case pattern+ - {#Item pattern' {#End}} - (in (partial_list pattern' body branches)) - - _ - (failure "`pattern` can only expand to 1 pattern."))) - - _ - (failure "Wrong syntax for `pattern` macro")))) - (def' .private pattern#or - Macro - (macro (_ tokens) - (case tokens - (pattern (partial_list [_ {#Form patterns}] body branches)) - (case patterns - {#End} - (failure "pattern#or cannot have 0 patterns") - - _ - (let' [pairs (|> patterns - (list#each (function' [pattern] (list pattern body))) - (list#conjoint))] - (meta#in (list#composite pairs branches)))) - _ - (failure "Wrong syntax for pattern#or")))) + Pattern + (pattern + (macro (_ tokens) + (case tokens + (list#partial [_ {#Form patterns}] body branches) + (case patterns + {#End} + (failure "pattern#or cannot have 0 patterns") + + _ + (let' [pairs (|> patterns + (list#each (function' [pattern] (list pattern body))) + (list#conjoint))] + (meta#in (list#composite pairs branches)))) + _ + (failure "Wrong syntax for pattern#or"))))) (def' .public symbol Macro (macro (_ tokens) (case tokens - (pattern (list [_ {#Symbol [module name]}])) + (list [_ {#Symbol [module name]}]) (meta#in (list (` [(, (text$ module)) (, (text$ name))]))) _ @@ -2932,7 +2938,7 @@ Macro (macro (_ tokens) (case tokens - (pattern (list [_ {#Tuple bindings}] body)) + (list [_ {#Tuple bindings}] body) (case (..pairs bindings) {#Some bindings} (|> bindings @@ -2958,7 +2964,7 @@ (macro (_ tokens) (case (is (Maybe [Text Code (List Code) Code]) (case tokens - (pattern (list [_ {#Form (partial_list [_ {#Symbol ["" name]}] head tail)}] body)) + (list [_ {#Form (list#partial [_ {#Symbol ["" name]}] head tail)}] body) {#Some name head tail body} _ @@ -2987,7 +2993,7 @@ (def' .private (parsed parser tokens) (type_literal (All (_ a) (-> (Parser a) (List Code) (Maybe a)))) (case (parser tokens) - (pattern {#Some [(list) it]}) + {#Some [(list) it]} {#Some it} _ @@ -3064,7 +3070,7 @@ (do maybe#monad [it (someP itP tokens) .let [[tokens tail] it]] - (in [tokens (partial_list head tail)])) + (in [tokens (list#partial head tail)])) {#None} {#Some [tokens (list)]})) @@ -3079,7 +3085,7 @@ .let [[tokens head] it] it (someP itP tokens) .let [[tokens tail] it]] - (in [tokens (partial_list head tail)]))) + (in [tokens (list#partial head tail)]))) (def' .private (maybeP itP tokens) (type_literal @@ -3098,7 +3104,7 @@ (All (_ a) (-> (Parser a) (Parser a)))) (case tokens - (pattern (partial_list [_ {#Tuple input}] tokens')) + (list#partial [_ {#Tuple input}] tokens') (do maybe#monad [it (parsed itP input)] (in [tokens' it])) @@ -3111,7 +3117,7 @@ (All (_ a) (-> (Parser a) (Parser a)))) (case tokens - (pattern (partial_list [_ {#Form input}] tokens')) + (list#partial [_ {#Form input}] tokens') (do maybe#monad [it (parsed itP input)] (in [tokens' it])) @@ -3122,7 +3128,7 @@ (def' .private (bindingP tokens) (type_literal (Parser [Text Code])) (case tokens - (pattern (partial_list [_ {#Symbol ["" name]}] value &rest)) + (list#partial [_ {#Symbol ["" name]}] value &rest) {#Some [&rest [name value]]} _ @@ -3131,7 +3137,7 @@ (def' .private (endP tokens) (type_literal (Parser Any)) (case tokens - (pattern (list)) + (list) {#Some [tokens []]} _ @@ -3140,7 +3146,7 @@ (def' .private (anyP tokens) (type_literal (Parser Code)) (case tokens - (pattern (partial_list code tokens')) + (list#partial code tokens') {#Some [tokens' code]} _ @@ -3149,7 +3155,7 @@ (def' .private (localP tokens) (type_literal (-> (List Code) (Maybe [(List Code) Text]))) (case tokens - (pattern (partial_list [_ {#Symbol ["" local]}] tokens')) + (list#partial [_ {#Symbol ["" local]}] tokens') {#Some [tokens' local]} _ @@ -3158,7 +3164,7 @@ (def' .private (symbolP tokens) (type_literal (-> (List Code) (Maybe [(List Code) Symbol]))) (case tokens - (pattern (partial_list [_ {#Symbol it}] tokens')) + (list#partial [_ {#Symbol it}] tokens') {#Some [tokens' it]} _ @@ -3186,7 +3192,7 @@ [(def' .private ( tokens) (type_literal (Parser [Text (List )])) (case tokens - (pattern (partial_list [_ {#Form local_declaration}] tokens')) + (list#partial [_ {#Form local_declaration}] tokens') (do maybe#monad [% (localP local_declaration) .let' [[local_declaration name] %] @@ -3206,7 +3212,7 @@ (def' .private (export_policyP tokens) (type_literal (-> (List Code) [(List Code) Code])) (case tokens - (pattern (partial_list candidate tokens')) + (list#partial candidate tokens') (case candidate [_ {#Bit it}] [tokens' candidate] @@ -3240,11 +3246,11 @@ (type_literal (-> (List Code) (Maybe [(List Code) [(Maybe Code) Code]]))) (case tokens ... TB - (pattern (partial_list type body tokens')) + (list#partial type body tokens') {#Some [tokens' [{#Some type} body]]} ... B - (pattern (partial_list body tokens')) + (list#partial body tokens') {#Some [tokens' [{#None} body]]} _ @@ -3290,7 +3296,7 @@ [(def .public (macro (_ tokens) (case (list#reversed tokens) - (pattern (partial_list last init)) + (list#partial last init) (meta#in (list (list#mix (is (-> Code Code Code) (function (_ pre post) (`
))) last @@ -3313,7 +3319,7 @@ (def maybe#else (macro (_ tokens state) (case tokens - (pattern (list else maybe)) + (list else maybe) (let [g!temp (is Code [dummy_location {#Symbol ["" ""]}]) code (` (case (, maybe) {.#Some (, g!temp)} @@ -3333,7 +3339,7 @@ (list input) {#Some idx} - (partial_list ("lux text clip" 0 idx input) + (list#partial ("lux text clip" 0 idx input) (text#all_split_by splitter (let [after_offset ("lux i64 +" 1 idx) after_length ("lux i64 -" @@ -3404,10 +3410,10 @@ (-> Type Type (Maybe Type)) (case type_fn {#UnivQ env body} - {#Some (reduced (partial_list type_fn param env) body)} + {#Some (reduced (list#partial type_fn param env) body)} {#ExQ env body} - {#Some (reduced (partial_list type_fn param env) body)} + {#Some (reduced (list#partial type_fn param env) body)} {#Apply A F} (do maybe#monad @@ -3425,7 +3431,7 @@ (-> Type (List Type)) (case type { left right} - (partial_list left ( right)) + (list#partial left ( right)) _ (list type)))] @@ -3607,8 +3613,8 @@ (macro (_ tokens) (do meta#monad [tokens' (monad#each meta#monad expansion tokens) - struct_type ..expected_type - tags+type (record_slots struct_type) + implementation_type ..expected_type + tags+type (record_slots implementation_type) tags (is (Meta (List Symbol)) (case tags+type {#Some [tags _]} @@ -3617,7 +3623,7 @@ _ (failure (all text#composite "No tags available for type: " - (type#encoded struct_type))))) + (type#encoded implementation_type))))) .let [tag_mappings (is (List [Text Code]) (list#each (function (_ tag) [(product#right tag) @@ -3627,7 +3633,7 @@ (is (-> Code (Meta (List Code))) (function (_ token) (case token - (pattern [_ {#Form (list [_ {#Text "lux def"}] [_ {#Symbol ["" slot_name]}] value export_policy)}]) + [_ {#Form (list [_ {#Text "lux def"}] [_ {#Symbol ["" slot_name]}] value export_policy)}] (case (property#value slot_name tag_mappings) {#Some tag} (in (list tag value)) @@ -3672,7 +3678,7 @@ {#End} (in (list)))] - (in (partial_list head tail))) + (in (list#partial head tail))) {#End} {#Some (list)})) @@ -3680,10 +3686,10 @@ (def (caseP tokens) (-> (List Code) (Maybe [(List Code) [Text Code]])) (case tokens - (pattern (partial_list [_ {#Variant (list [_ {#Symbol ["" niladic]}])}] tokens')) + (list#partial [_ {#Variant (list [_ {#Symbol ["" niladic]}])}] tokens') {#Some [tokens' [niladic (` .Any)]]} - (pattern (partial_list [_ {#Variant (partial_list [_ {#Symbol ["" polyadic]}] caseT)}] tokens')) + (list#partial [_ {#Variant (list#partial [_ {#Symbol ["" polyadic]}] caseT)}] tokens') {#Some [tokens' [polyadic (` (..Tuple (,* caseT)))]]} _ @@ -3704,7 +3710,7 @@ (def (slotP tokens) (-> (List Code) (Maybe [(List Code) [Text Code]])) (case tokens - (pattern (partial_list [_ {#Symbol ["" slot]}] type tokens')) + (list#partial [_ {#Symbol ["" slot]}] type tokens') {#Some [tokens' [slot type]]} _ @@ -3713,7 +3719,7 @@ (def .public Record (macro (_ tokens) (case tokens - (pattern (list [_ {#Tuple record}])) + (list [_ {#Tuple record}]) (case (everyP slotP record) {#Some slots} (meta#in (list (` (..Tuple (,* (list#each product#right slots)))) @@ -3740,7 +3746,7 @@ (def (textP tokens) (-> (List Code) (Maybe [(List Code) Text])) (case tokens - (pattern (partial_list [_ {#Text it}] tokens')) + (list#partial [_ {#Text it}] tokens') {#Some [tokens' it]} _ @@ -3750,9 +3756,9 @@ (-> Code (Meta (Tuple Code (Maybe (Either (List Text) (List Text)))))) ({[_ {#Form {#Item [_ {#Symbol declarer}] parameters}}] (do meta#monad - [declaration (single_expansion (form$ (partial_list (symbol$ declarer) parameters)))] + [declaration (single_expansion (form$ (list#partial (symbol$ declarer) parameters)))] (case declaration - (pattern (list type [_ {#Variant tags}])) + (list type [_ {#Variant tags}]) (case (everyP textP tags) {#Some tags} (meta#in [type {#Some {#Left tags}}]) @@ -3760,7 +3766,7 @@ {#None} (failure "Improper type-definition syntax")) - (pattern (list type [_ {#Tuple slots}])) + (list type [_ {#Tuple slots}]) (case (everyP textP slots) {#Some slots} (meta#in [type {#Some {#Right slots}}]) @@ -3768,7 +3774,7 @@ {#None} (failure "Improper type-definition syntax")) - (pattern (list type)) + (list type) (meta#in [it {#None}]) _ @@ -3927,7 +3933,8 @@ (def (list#after amount list) (All (_ a) (-> Nat (List a) (List a))) (case [amount list] - (pattern#or [0 _] [_ {#End}]) + (pattern#or [0 _] + [_ {#End}]) list [_ {#Item _ tail}] @@ -3968,7 +3975,7 @@ (function (_ token) (case token ... Nested - (pattern [_ {#Tuple (partial_list [_ {#Symbol ["" module_name]}] extra)}]) + [_ {#Tuple (list#partial [_ {#Symbol ["" module_name]}] extra)}] (do meta#monad [absolute_module_name (case (normal_parallel_path relative_root module_name) {#Some parallel_path} @@ -3989,12 +3996,12 @@ sub_imports _ - (partial_list [#import_name absolute_module_name + (list#partial [#import_name absolute_module_name #import_alias {#None} #import_referrals referral] sub_imports)))) - (pattern [_ {#Tuple (partial_list [_ {#Text alias}] [_ {#Symbol ["" module_name]}] extra)}]) + [_ {#Tuple (list#partial [_ {#Text alias}] [_ {#Symbol ["" module_name]}] extra)}] (do meta#monad [absolute_module_name (case (normal_parallel_path relative_root module_name) {#Some parallel_path} @@ -4016,7 +4023,7 @@ sub_imports _ - (partial_list [#import_name absolute_module_name + (list#partial [#import_name absolute_module_name #import_alias {#Some module_alias} #import_referrals referral] sub_imports)))) @@ -4225,19 +4232,19 @@ (let [temp (is (Either Text [Lux Type]) (if (text#= "" module) (case (in_env name compiler) - {#Some struct_type} - {#Right [compiler struct_type]} + {#Some implementation_type} + {#Right [compiler implementation_type]} _ (case (definition_type [current_module name] compiler) - {#Some struct_type} - {#Right [compiler struct_type]} + {#Some implementation_type} + {#Right [compiler implementation_type]} _ {#Left (all text#composite "Unknown var: " (symbol#encoded full_name))})) (case (definition_type full_name compiler) - {#Some struct_type} - {#Right [compiler struct_type]} + {#Some implementation_type} + {#Right [compiler implementation_type]} _ {#Left (all text#composite "Unknown var: " (symbol#encoded full_name))})))] @@ -4259,67 +4266,103 @@ temp)) ))) -(def .public open - (macro (_ tokens) - (case tokens - (pattern (partial_list [_ {#Form (list [_ {#Text alias}])}] body branches)) - (do meta#monad - [g!temp (..generated_symbol "temp")] - (in (partial_list g!temp (` (..open (, g!temp) (, (text$ alias)) (, body))) branches))) +(def (list#all choice items) + (All (_ a b) (-> (-> a (Maybe b)) (List a) (List b))) + (case items + {#Item head tail} + (case (choice head) + {#Some head} + {#Item head (list#all choice tail)} + + {#None} + (list#all choice tail)) + + {#End} + {#End})) - (pattern (list [_ {#Symbol name}] [_ {#Text alias}] body)) - (do meta#monad - [init_type (type_definition name) - struct_evidence (record_slots init_type)] - (case struct_evidence - {#None} - (failure (text#composite "Can only 'open' structs: " (type#encoded init_type))) +(type Implementation_Interface + [(List Symbol) (List Type)]) - {#Some tags&members} - (do meta#monad - [full_body ((is (-> Symbol [(List Symbol) (List Type)] Code (Meta Code)) - (function (again source [tags members] target) - (let [locals (list#each (function (_ [t_module t_name]) - [[t_module t_name] - ["" (..module_alias (list t_name) alias)]]) - tags) - pattern (case locals - (pattern (list [slot binding])) - (symbol$ binding) - - _ - (|> locals - (list#each (function (_ [slot binding]) - (list (symbol$ slot) - (symbol$ binding)))) - list#conjoint - tuple$))] - (do meta#monad - [enhanced_target (monad#mix meta#monad - (function (_ [[_ m_local] m_type] enhanced_target) - (do meta#monad - [m_implementation (record_slots m_type)] - (case m_implementation - {#Some m_tags&members} - (again m_local - m_tags&members - enhanced_target) - - {#None} - (in enhanced_target)))) - target - (zipped_2 locals members))] - (in (` ({(, pattern) (, enhanced_target)} (, (symbol$ source))))))))) - name tags&members body)] - (in (list full_body))))) +(def (open_layer alias [tags members]) + (-> Text Implementation_Interface (Meta [Code (List [Symbol Implementation_Interface])])) + (do meta#monad + [pattern (monad#each meta#monad + (function (_ [slot slot_type]) + (do meta#monad + [.let [[_ slot_name] slot + local ["" (..module_alias (list slot_name) alias)]] + implementation (record_slots slot_type)] + (in [(list (symbol$ slot) + (symbol$ local)) + [local implementation]]))) + (zipped_2 tags members))] + (in [(|> pattern + (list#each product#left) + list#conjoint + tuple$) + (list#all (function (_ [_ [sub_binding sub_implementation]]) + (do maybe#monad + [sub_implementation sub_implementation] + (in [sub_binding sub_implementation]))) + pattern)]))) + +(def (open_layers alias interfaces body) + (-> Text (List Implementation_Interface) Code (Meta [Code Code])) + (do meta#monad + [layer (monad#each meta#monad (open_layer alias) interfaces) + .let [pattern (tuple$ (list#each product#left layer)) + next (|> layer + (list#each product#right) + list#conjoint)]] + (case next + {#End} + (in [pattern body]) _ - (failure (..wrong_syntax_error (symbol ..open)))))) + (do meta#monad + [.let [sub_value (tuple$ (list#each (|>> product#left symbol$) next))] + sub_pattern,sub_body (open_layers alias (list#each product#right next) body) + .let [[sub_pattern sub_body] sub_pattern,sub_body]] + (in [pattern (` (case (, sub_value) + (, sub_pattern) + (, sub_body)))]))))) + +(def .public open + (pattern + (macro (_ tokens) + (case tokens + (list#partial [_ {#Form (list [_ {#Text alias}])}] body branches) + (do meta#monad + [g!temp (..generated_symbol "temp")] + (in (list#partial g!temp + (` (..case (, g!temp) + (..open (, g!temp) (, (text$ alias))) + (, body))) + branches))) + + (list#partial [_ {#Form (list [@temp_var {#Symbol name}] [_ {#Text alias}])}] + body + branches) + (do meta#monad + [init_type (type_definition name) + implementation_evidence (record_slots init_type)] + (case implementation_evidence + {#None} + (failure (text#composite "Can only 'open' implementations: " (type#encoded init_type))) + + {#Some tags,members} + (do meta#monad + [pattern,body (open_layers alias (list tags,members) body) + .let [[pattern body] pattern,body]] + (in (list#partial pattern body branches))))) + + _ + (failure (..wrong_syntax_error (symbol ..open))))))) (def .public cond (macro (_ tokens) (case (list#reversed tokens) - (pattern (partial_list else branches')) + (list#partial else branches') (case (pairs branches') {#Some branches'} (meta#in (list (list#mix (is (-> [Code Code] Code Code) @@ -4353,7 +4396,7 @@ (def .public the (macro (_ tokens) (case tokens - (pattern (list [_ {#Symbol slot'}] record)) + (list [_ {#Symbol slot'}] record) (do meta#monad [slot (normal slot') output (..type_slot slot) @@ -4376,14 +4419,14 @@ _ (failure "the can only use records."))) - (pattern (list [_ {#Tuple slots}] record)) + (list [_ {#Tuple slots}] record) (meta#in (list (list#mix (is (-> Code Code Code) (function (_ slot inner) (` (..the (, slot) (, inner))))) record slots))) - (pattern (list selector)) + (list selector) (do meta#monad [g!_ (..generated_symbol "_") g!record (..generated_symbol "record")] @@ -4438,7 +4481,7 @@ _ (failure (all text#composite - "Can only 'use' structs: " (symbol#encoded implementation) + "Can only 'use' implementations: " (symbol#encoded implementation) " : " (type#encoded interface)))))) (def (localized module global) @@ -4540,7 +4583,7 @@ (def refer (macro (_ tokens) (case tokens - (pattern (partial_list [_ {#Text imported_module}] [_ {#Text alias}] options)) + (list#partial [_ {#Text imported_module}] [_ {#Text alias}] options) (do meta#monad [referrals (..referrals imported_module options) current_module ..current_module_name] @@ -4569,11 +4612,11 @@ (def .public at (macro (_ tokens) (case tokens - (pattern (list implementation [_ {#Symbol member}])) + (list implementation [_ {#Symbol member}]) (meta#in (list (` (..with (, implementation) (, (symbol$ member)))))) - (pattern (partial_list struct member args)) - (meta#in (list (` ((..at (, struct) (, member)) (,* args))))) + (list#partial implementation member args) + (meta#in (list (` ((..at (, implementation) (, member)) (,* args))))) _ (failure (..wrong_syntax_error (symbol ..at)))))) @@ -4581,7 +4624,7 @@ (def .public has (macro (_ tokens) (case tokens - (pattern (list [_ {#Symbol slot'}] value record)) + (list [_ {#Symbol slot'}] value record) (do meta#monad [slot (normal slot') output (..type_slot slot) @@ -4617,7 +4660,7 @@ _ (failure "has can only use records."))) - (pattern (list [_ {#Tuple slots}] value record)) + (list [_ {#Tuple slots}] value record) (case slots {#End} (failure (..wrong_syntax_error (symbol ..has))) @@ -4644,14 +4687,14 @@ (in (list (` (let [(,* accesses)] (, update_expr))))))) - (pattern (list selector value)) + (list selector value) (do meta#monad [g!_ (..generated_symbol "_") g!record (..generated_symbol "record")] (in (list (` (function ((, g!_) (, g!record)) (..has (, selector) (, value) (, g!record))))))) - (pattern (list selector)) + (list selector) (do meta#monad [g!_ (..generated_symbol "_") g!value (..generated_symbol "value") @@ -4665,7 +4708,7 @@ (def .public revised (macro (_ tokens) (case tokens - (pattern (list [_ {#Symbol slot'}] fun record)) + (list [_ {#Symbol slot'}] fun record) (do meta#monad [slot (normal slot') output (..type_slot slot) @@ -4701,7 +4744,7 @@ _ (failure "revised can only use records."))) - (pattern (list [_ {#Tuple slots}] fun record)) + (list [_ {#Tuple slots}] fun record) (case slots {#End} (failure (..wrong_syntax_error (symbol ..revised))) @@ -4714,14 +4757,14 @@ (, g!temp) (the [(,* slots)] (, g!record))] (has [(,* slots)] ((, fun) (, g!temp)) (, g!record)))))))) - (pattern (list selector fun)) + (list selector fun) (do meta#monad [g!_ (..generated_symbol "_") g!record (..generated_symbol "record")] (in (list (` (function ((, g!_) (, g!record)) (..revised (, selector) (, fun) (, g!record))))))) - (pattern (list selector)) + (list selector) (do meta#monad [g!_ (..generated_symbol "_") g!fun (..generated_symbol "fun") @@ -4733,34 +4776,35 @@ (failure (..wrong_syntax_error (symbol ..revised)))))) (def .private with_template#pattern - (macro (_ tokens) - (case tokens - (pattern (partial_list [_ {#Form (list [_ {#Tuple bindings}] - [_ {#Tuple templates}])}] - [_ {#Form data}] - branches)) - (case (is (Maybe (List Code)) - (do maybe#monad - [bindings' (monad#each maybe#monad symbol_short bindings) - data' (monad#each maybe#monad tuple_list data)] - (let [num_bindings (list#size bindings')] - (if (every? (|>> ("lux i64 =" num_bindings)) - (list#each list#size data')) - (let [apply (is (-> Replacement_Environment (List Code)) - (function (_ env) (list#each (realized_template env) templates)))] - (|> data' - (list#each (function#composite apply (replacement_environment bindings'))) - list#conjoint - in)) - {#None})))) - {#Some output} - (meta#in (list#composite output branches)) - - {#None} - (failure (..wrong_syntax_error (symbol ..with_template#pattern)))) - - _ - (failure (..wrong_syntax_error (symbol ..with_template#pattern)))))) + (pattern + (macro (_ tokens) + (case tokens + (list#partial [_ {#Form (list [_ {#Tuple bindings}] + [_ {#Tuple templates}])}] + [_ {#Form data}] + branches) + (case (is (Maybe (List Code)) + (do maybe#monad + [bindings' (monad#each maybe#monad symbol_short bindings) + data' (monad#each maybe#monad tuple_list data)] + (let [num_bindings (list#size bindings')] + (if (every? (|>> ("lux i64 =" num_bindings)) + (list#each list#size data')) + (let [apply (is (-> Replacement_Environment (List Code)) + (function (_ env) (list#each (realized_template env) templates)))] + (|> data' + (list#each (function#composite apply (replacement_environment bindings'))) + list#conjoint + in)) + {#None})))) + {#Some output} + (meta#in (list#composite output branches)) + + {#None} + (failure (..wrong_syntax_error (symbol ..with_template#pattern)))) + + _ + (failure (..wrong_syntax_error (symbol ..with_template#pattern))))))) (with_template [ ] [(def .public @@ -4785,7 +4829,7 @@ {#End} {#Item y ys'} - (partial_list x y (interleaved xs' ys'))))) + (list#partial x y (interleaved xs' ys'))))) (def (type_code type) (-> Type Code) @@ -4821,7 +4865,7 @@ (def .public loop (macro (_ tokens) (let [?params (case tokens - (pattern (list [_ {#Form (list name [_ {#Tuple bindings}])}] body)) + (list [_ {#Form (list name [_ {#Tuple bindings}])}] body) {#Some [name bindings body]} _ @@ -4864,7 +4908,12 @@ (def (with_expansions' label tokens target) (-> Text (List Code) Code (List Code)) (case target - (pattern#or [_ {#Bit _}] [_ {#Nat _}] [_ {#Int _}] [_ {#Rev _}] [_ {#Frac _}] [_ {#Text _}]) + (pattern#or [_ {#Bit _}] + [_ {#Nat _}] + [_ {#Int _}] + [_ {#Rev _}] + [_ {#Frac _}] + [_ {#Text _}]) (list target) [_ {#Symbol [module name]}] @@ -4897,7 +4946,7 @@ {#Item [var_name expr] &rest} (do meta#monad [expansion (case (normal expr) - (pattern (list expr)) + (list expr) (single_expansion expr) _ @@ -4979,7 +5028,7 @@ (def .public static (macro (_ tokens) (case tokens - (pattern (list pattern)) + (list pattern) (do meta#monad [pattern' (static_literal pattern)] (in (list pattern'))) @@ -4992,13 +5041,12 @@ (def (case_level^ level) (-> Code (Meta [Code Code])) - (case level - (pattern [_ {#Tuple (list expr binding)}]) - (meta#in [expr binding]) + (meta#in (case level + [_ {#Tuple (list expr binding)}] + [expr binding] - _ - (meta#in [level (` #1)]) - )) + _ + [level (` #1)]))) (def (multi_level_case^ levels) (-> (List Code) (Meta Multi_Level_Case)) @@ -5032,36 +5080,37 @@ (list init_pattern inner_pattern_body))) (def pattern#multi - (macro (_ tokens) - (case tokens - (pattern (partial_list [_meta {#Form levels}] body next_branches)) - (do meta#monad - [mlc (multi_level_case^ levels) - .let [initial_bind? (case mlc - [[_ {#Symbol _}] _] - #1 - - _ - #0)] - expected ..expected_type - g!temp (..generated_symbol "temp")] - (in (list g!temp - (` ({{.#Some (, g!temp)} - (, g!temp) - - {.#None} - (case (, g!temp) - (,* next_branches))} - ("lux type check" {.#Apply (, (type_code expected)) Maybe} - (case (, g!temp) - (,* (multi_level_case$ g!temp [mlc body])) - - (,* (if initial_bind? - (list) - (list g!temp (` {.#None}))))))))))) - - _ - (failure (..wrong_syntax_error (symbol ..pattern#multi)))))) + (pattern + (macro (_ tokens) + (case tokens + (list#partial [_meta {#Form levels}] body next_branches) + (do meta#monad + [mlc (multi_level_case^ levels) + .let [initial_bind? (case mlc + [[_ {#Symbol _}] _] + #1 + + _ + #0)] + expected ..expected_type + g!temp (..generated_symbol "temp")] + (in (list g!temp + (` ({{.#Some (, g!temp)} + (, g!temp) + + {.#None} + (case (, g!temp) + (,* next_branches))} + ("lux type check" {.#Apply (, (type_code expected)) Maybe} + (case (, g!temp) + (,* (multi_level_case$ g!temp [mlc body])) + + (,* (if initial_bind? + (list) + (list g!temp (` {.#None}))))))))))) + + _ + (failure (..wrong_syntax_error (symbol ..pattern#multi))))))) (def .public (same? reference sample) (All (_ a) @@ -5071,7 +5120,7 @@ (def .public as_expected (macro (_ tokens) (case tokens - (pattern (list expr)) + (list expr) (do meta#monad [type ..expected_type] (in (list (` ("lux type as" (, (type_code type)) (, expr)))))) @@ -5101,12 +5150,12 @@ (def .public type_of (macro (_ tokens) (case tokens - (pattern (list [_ {#Symbol var_name}])) + (list [_ {#Symbol var_name}]) (do meta#monad [var_type (type_definition var_name)] (in (list (type_code var_type)))) - (pattern (list expression)) + (list expression) (do meta#monad [g!temp (..generated_symbol "g!temp")] (in (list (` (let [(, g!temp) (, expression)] @@ -5139,7 +5188,7 @@ this_module current_module_name] (in (list (` (..macro ((, (local$ name)) (, g!tokens) (, g!compiler)) (case (, g!tokens) - (pattern (list (,* (list#each local$ args)))) + (list (,* (list#each local$ args))) {.#Right [(, g!compiler) (list (,* (list#each (function (_ template) (` (`' (, (with_replacements rep_env @@ -5170,7 +5219,7 @@ (def .public char (macro (_ tokens compiler) (case tokens - (pattern#multi (pattern (list [_ {#Text input}])) + (pattern#multi (list [_ {#Text input}]) (|> input "lux text size" ("lux i64 =" 1))) (|> input ("lux text char" 0) nat$ list @@ -5254,7 +5303,7 @@ (def .public parameter (macro (_ tokens) (case tokens - (pattern (list [_ {#Nat idx}])) + (list [_ {#Nat idx}]) (do meta#monad [stvs ..scope_type_vars] (case (..item idx (list#reversed stvs)) @@ -5300,7 +5349,7 @@ ... {library/lux/tool/compiler/language/lux/generation.no_buffer_for_saving_code} ... Artifact ID: 0 ... Which only ever happens for the Python compiler. - (partial_list (` ("lux def" (, g!_) [] #0)) + (list#partial (` ("lux def" (, g!_) [] #0)) =refers) =refers)})))) @@ -5319,7 +5368,7 @@ (..immediate_unquote (macro (_ it) (case it - (pattern (list it)) + (list it) (meta#in (list it)) _ @@ -5348,8 +5397,8 @@ (def (embedded_expansions code) (-> Code (Meta [(List Code) Code])) (case code - (pattern [@ {#Form (partial_list [@symbol {#Symbol original_symbol}] parameters)}]) - (with_expansions [ (aggregate_embedded_expansions embedded_expansions @ #Form (partial_list [@symbol {#Symbol original_symbol}] parameters))] + [@ {#Form (list#partial [@symbol {#Symbol original_symbol}] parameters)}] + (with_expansions [ (aggregate_embedded_expansions embedded_expansions @ #Form (list#partial [@symbol {#Symbol original_symbol}] parameters))] (do meta#monad [resolved_symbol (..normal original_symbol) ?resolved_symbol (meta#try (..global_symbol resolved_symbol))] @@ -5386,7 +5435,7 @@ (def .public `` (macro (_ tokens) (case tokens - (pattern (list raw)) + (list raw) (do meta#monad [=raw (..embedded_expansions raw) .let [[labels labelled] =raw]] @@ -5406,7 +5455,7 @@ (def .public try (macro (_ tokens) (case tokens - (pattern (list expression)) + (list expression) (do meta#monad [g!_ (..generated_symbol "g!_")] (in (list (` ("lux try" @@ -5419,10 +5468,10 @@ (def (methodP tokens) (-> (List Code) (Maybe [(List Code) [Text Code]])) (case tokens - (pattern (partial_list [_ {#Form (list [_ {#Text "lux type check"}] - type - [_ {#Symbol ["" name]}])}] - tokens')) + (list#partial [_ {#Form (list [_ {#Text "lux type check"}] + type + [_ {#Symbol ["" name]}])}] + tokens') {#Some [tokens' [name type]]} _ @@ -5450,16 +5499,16 @@ (def .public Rec (macro (_ tokens) (case tokens - (pattern (list [_ {#Symbol "" name}] body)) + (list [_ {#Symbol "" name}] body) (do meta#monad [body' (expansion body) g!self (generated_symbol "g!self") g!dummy (generated_symbol "g!dummy")] (case body' - (pattern (list body' labels)) + (list body' labels) (in (list (..recursive_type g!self g!dummy name body') labels)) - (pattern (list body')) + (list body') (in (list (..recursive_type g!self g!dummy name body'))) _ diff --git a/stdlib/source/library/lux/abstract/comonad.lux b/stdlib/source/library/lux/abstract/comonad.lux index fbe61f780..15a1e96d3 100644 --- a/stdlib/source/library/lux/abstract/comonad.lux +++ b/stdlib/source/library/lux/abstract/comonad.lux @@ -27,10 +27,10 @@ (macro (_ tokens state) (case (is (Maybe [(Maybe Text) Code (List Code) Code]) (case tokens - (pattern (list [_ {.#Tuple (list [_ {.#Symbol ["" name]}] comonad)}] [_ {.#Tuple bindings}] body)) + (list [_ {.#Tuple (list [_ {.#Symbol ["" name]}] comonad)}] [_ {.#Tuple bindings}] body) {.#Some [{.#Some name} comonad bindings body]} - (pattern (list comonad [_ {.#Tuple bindings}] body)) + (list comonad [_ {.#Tuple bindings}] body) {.#Some [{.#None} comonad bindings body]} _ diff --git a/stdlib/source/library/lux/abstract/monad.lux b/stdlib/source/library/lux/abstract/monad.lux index 33faf1290..71f981b3e 100644 --- a/stdlib/source/library/lux/abstract/monad.lux +++ b/stdlib/source/library/lux/abstract/monad.lux @@ -58,10 +58,10 @@ (macro (_ tokens state) (case (is (Maybe [(Maybe Text) Code (List Code) Code]) (case tokens - (pattern (list [_ {.#Tuple (list [_ {.#Symbol ["" name]}] monad)}] [_ {.#Tuple bindings}] body)) + (list [_ {.#Tuple (list [_ {.#Symbol ["" name]}] monad)}] [_ {.#Tuple bindings}] body) {.#Some [{.#Some name} monad bindings body]} - (pattern (list monad [_ {.#Tuple bindings}] body)) + (list monad [_ {.#Tuple bindings}] body) {.#Some [{.#None} monad bindings body]} _ diff --git a/stdlib/source/library/lux/control/maybe.lux b/stdlib/source/library/lux/control/maybe.lux index 15daadb8b..a48e3661e 100644 --- a/stdlib/source/library/lux/control/maybe.lux +++ b/stdlib/source/library/lux/control/maybe.lux @@ -128,7 +128,7 @@ (def .public else (macro (_ tokens state) (case tokens - (pattern (.list else maybe)) + (.list else maybe) (let [g!temp (is Code [location.dummy {.#Symbol ["" ""]}])] {.#Right [state (.list (` (.case (, maybe) {.#Some (, g!temp)} @@ -158,7 +158,7 @@ (def .public when (macro (_ tokens state) (case tokens - (pattern (.list test then)) + (.list test then) {.#Right [state (.list (` (.if (, test) (, then) {.#None})))]} diff --git a/stdlib/source/library/lux/control/pipe.lux b/stdlib/source/library/lux/control/pipe.lux index 23990201d..2198abe8a 100644 --- a/stdlib/source/library/lux/control/pipe.lux +++ b/stdlib/source/library/lux/control/pipe.lux @@ -89,7 +89,7 @@ prev .any]) (with_symbols [g!temp] (.case (list.reversed steps) - (pattern (list.partial last_step prev_steps)) + (list.partial last_step prev_steps) (.let [step_bindings (monad.do list.monad [step (list.reversed prev_steps)] (list g!temp (` (|> (, g!temp) (,* step)))))] diff --git a/stdlib/source/library/lux/control/try.lux b/stdlib/source/library/lux/control/try.lux index 2e86903c7..fe17409a2 100644 --- a/stdlib/source/library/lux/control/try.lux +++ b/stdlib/source/library/lux/control/try.lux @@ -141,7 +141,7 @@ (def .public else (macro (_ tokens compiler) (case tokens - (pattern (list else try)) + (list else try) {#Success [compiler (list (` (case (, try) {..#Success (,' g!temp)} (,' g!temp) @@ -156,7 +156,7 @@ (def .public when (macro (_ tokens state) (case tokens - (pattern (.list test then)) + (.list test then) (let [code#encoded ("lux in-module" "library/lux" .code#encoded) text$ ("lux in-module" "library/lux" .text$)] {.#Right [state (.list (` (.if (, test) diff --git a/stdlib/source/library/lux/data/collection/list.lux b/stdlib/source/library/lux/data/collection/list.lux index 176b9d9b4..c6e0f8587 100644 --- a/stdlib/source/library/lux/data/collection/list.lux +++ b/stdlib/source/library/lux/data/collection/list.lux @@ -97,7 +97,7 @@ (def .public (pairs xs) (All (_ a) (-> (List a) (Maybe (List [a a])))) (case xs - (pattern (partial x1 x2 xs')) + (partial x1 x2 xs') (case (pairs xs') {.#Some tail} {.#Some (partial [x1 x2] tail)} @@ -105,7 +105,7 @@ {.#None} {.#None}) - (pattern (list)) + (list) {.#Some (list)} _ @@ -476,7 +476,7 @@ (def .public zipped (macro (_ tokens state) (case tokens - (pattern (list [_ {.#Nat num_lists}])) + (list [_ {.#Nat num_lists}]) (if (n.> 0 num_lists) (let [(open "[0]") ..functor indices (..indices num_lists) @@ -517,7 +517,7 @@ (def .public zipped_with (macro (_ tokens state) (case tokens - (pattern (list [_ {.#Nat num_lists}])) + (list [_ {.#Nat num_lists}]) (if (n.> 0 num_lists) (let [(open "[0]") ..functor indices (..indices num_lists) @@ -630,7 +630,7 @@ (def .public when (macro (_ tokens state) (case tokens - (pattern (.list test then)) + (list test then) {.#Right [state (.list (` (.if (, test) (, then) (.list))))]} diff --git a/stdlib/source/library/lux/data/collection/queue.lux b/stdlib/source/library/lux/data/collection/queue.lux index 361690fd7..0420c1954 100644 --- a/stdlib/source/library/lux/data/collection/queue.lux +++ b/stdlib/source/library/lux/data/collection/queue.lux @@ -55,17 +55,17 @@ (All (_ a) (-> (Queue a) (Queue a))) (case (the #front queue) ... Empty... - (pattern (.list)) + (.list) queue ... Front has dried up... - (pattern (.list _)) + (.list _) (|> queue (has #front (list.reversed (the #rear queue))) (has #rear (.list))) ... Consume front! - (pattern (list.partial _ front')) + (list.partial _ front') (|> queue (has #front front')))) diff --git a/stdlib/source/library/lux/data/collection/stream.lux b/stdlib/source/library/lux/data/collection/stream.lux index e0b2088ee..6d9d358e3 100644 --- a/stdlib/source/library/lux/data/collection/stream.lux +++ b/stdlib/source/library/lux/data/collection/stream.lux @@ -129,14 +129,15 @@ (//.pending [wa (disjoint tail)]))))) (def .public pattern - (syntax (_ [patterns (.form (<>.many .any)) - body .any - branches (<>.some .any)]) - (with_symbols [g!stream] - (let [body+ (` (let [(,* (|> patterns - (list#each (function (_ pattern) - (list (` [(, pattern) (, g!stream)]) - (` ((,! //.result) (, g!stream)))))) - list#conjoint))] - (, body)))] - (in (list.partial g!stream body+ branches)))))) + (.pattern + (syntax (_ [patterns (.form (<>.many .any)) + body .any + branches (<>.some .any)]) + (with_symbols [g!stream] + (let [body+ (` (let [(,* (|> patterns + (list#each (function (_ pattern) + (list (` [(, pattern) (, g!stream)]) + (` ((,! //.result) (, g!stream)))))) + list#conjoint))] + (, body)))] + (in (list.partial g!stream body+ branches))))))) diff --git a/stdlib/source/library/lux/data/format/tar.lux b/stdlib/source/library/lux/data/format/tar.lux index 32ec4bdaa..e5924fa6e 100644 --- a/stdlib/source/library/lux/data/format/tar.lux +++ b/stdlib/source/library/lux/data/format/tar.lux @@ -243,7 +243,7 @@ 0 (at utf8.codec encoded "") _ (let [last_char (binary!.bits_8 end string)] (`` (case (.nat last_char) - (pattern (char (,, (static ..null)))) + (char (,, (static ..null))) (again (-- end)) _ @@ -433,7 +433,7 @@ [it .bits_8] (case (.nat it) (^.with_template [ ] - [(pattern ) + [ (in )]) () diff --git a/stdlib/source/library/lux/data/format/xml.lux b/stdlib/source/library/lux/data/format/xml.lux index 2f1c9b910..3635c56f3 100644 --- a/stdlib/source/library/lux/data/format/xml.lux +++ b/stdlib/source/library/lux/data/format/xml.lux @@ -252,7 +252,7 @@ {#Text value} (sanitize_value value) - (pattern {#Node xml_tag xml_attrs (list {#Text value})}) + {#Node xml_tag xml_attrs (list {#Text value})} (let [tag (..tag xml_tag) attrs (if (dictionary.empty? xml_attrs) "" diff --git a/stdlib/source/library/lux/data/text.lux b/stdlib/source/library/lux/data/text.lux index b9e6d0d07..826afbb44 100644 --- a/stdlib/source/library/lux/data/text.lux +++ b/stdlib/source/library/lux/data/text.lux @@ -188,7 +188,7 @@ (for @.js (these (def defined? (macro (_ tokens lux) (case tokens - (pattern (list it)) + (list it) {.#Right [lux (list (` (.case ("js type-of" ("js constant" (, it))) "undefined" .false @@ -201,7 +201,7 @@ (def if_nashorn (macro (_ tokens lux) (case tokens - (pattern (list then else)) + (list then else) {.#Right [lux (list (if (and (..defined? "java") (..defined? "java.lang") (..defined? "java.lang.Object")) @@ -339,7 +339,7 @@ (def .public (space? char) (-> Char Bit) (with_expansions [ (with_template [] - [(pattern (.char (,, (static ))))] + [(.char (,, (static )))] [..tab] [..vertical_tab] diff --git a/stdlib/source/library/lux/data/text/escape.lux b/stdlib/source/library/lux/data/text/escape.lux index 6dc9c137f..6041931ff 100644 --- a/stdlib/source/library/lux/data/text/escape.lux +++ b/stdlib/source/library/lux/data/text/escape.lux @@ -74,7 +74,7 @@ (n.> ..ascii_top char) (case char (^.with_template [] - [(pattern (static )) + [(static ) true]) ([..\0] [..\a] [..\b] [..\t] [..\n] [..\v] [..\f] [..\r] @@ -119,7 +119,7 @@ (if (n.< limit offset) (case ("lux text char" offset current) (^.with_template [ ] - [(pattern (static )) + [(static ) (let [[previous' current' limit'] (ascii_escaped offset limit previous current)] (again 0 previous' current' limit'))]) ([..\0 ..escaped_\0] @@ -202,12 +202,12 @@ limit ("lux text size" text)]) (if (n.< limit offset) (case ("lux text char" offset current) - (pattern (static ..sigil_char)) + (static ..sigil_char) (let [@sigil (++ offset)] (if (n.< limit @sigil) (case ("lux text char" @sigil current) (^.with_template [ ] - [(pattern (static )) + [(static ) (let [[previous' current' limit'] (..ascii_un_escaped offset previous current limit)] (again 0 previous' current' limit'))]) ([..\0_sigil //.\0] @@ -221,7 +221,7 @@ [..\''_sigil //.\''] [..\\_sigil ..sigil]) - (pattern (static ..\u_sigil)) + (static ..\u_sigil) (let [@unicode (n.+ code_size @sigil)] (if (n.< limit @unicode) (do try.monad diff --git a/stdlib/source/library/lux/data/text/regex.lux b/stdlib/source/library/lux/data/text/regex.lux index c78edc826..9492101c6 100644 --- a/stdlib/source/library/lux/data/text/regex.lux +++ b/stdlib/source/library/lux/data/text/regex.lux @@ -429,12 +429,13 @@ (in (list regex)))))) (def .public pattern - (syntax (_ [[pattern bindings] (.form (<>.and .text (<>.maybe .any))) - body .any - branches (<>.many .any)]) - (with_symbols [g!temp] - (in (list.partial (` (^.multi (, g!temp) - [((,! .result) (..regex (, (code.text pattern))) (, g!temp)) - {try.#Success (, (maybe.else g!temp bindings))}])) - body - branches))))) + (.pattern + (syntax (_ [[pattern bindings] (.form (<>.and .text (<>.maybe .any))) + body .any + branches (<>.many .any)]) + (with_symbols [g!temp] + (in (list.partial (` (^.multi (, g!temp) + [((,! .result) (..regex (, (code.text pattern))) (, g!temp)) + {try.#Success (, (maybe.else g!temp bindings))}])) + body + branches)))))) diff --git a/stdlib/source/library/lux/documentation.lux b/stdlib/source/library/lux/documentation.lux index eb030edec..8159c5ed4 100644 --- a/stdlib/source/library/lux/documentation.lux +++ b/stdlib/source/library/lux/documentation.lux @@ -271,10 +271,10 @@ ([.#UnivQ "All" type.flat_univ_q] [.#ExQ "Ex" type.flat_ex_q]) - (pattern {.#Apply (|recursion_dummy|) {.#Parameter 0}}) + {.#Apply (|recursion_dummy|) {.#Parameter 0}} type_function_name - (pattern {.#Apply (|recursion_dummy|) {.#UnivQ _ body}}) + {.#Apply (|recursion_dummy|) {.#UnivQ _ body}} (format "(Rec " type_function_name \n (nested " " (%type' level type_function_name nestable? module body)) ")") @@ -316,7 +316,7 @@ (def (type_definition' nestable? level arity type_function_info tags module type) (-> Bit Nat Nat [Text (List Text)] (List Text) Text Type Text) (case tags - (pattern (list single_tag)) + (list single_tag) (format "(Record" \n " [#" single_tag " " (type_definition' false level arity type_function_info {.#None} module type) "])") @@ -406,10 +406,10 @@ [.#ExQ "Ex" type.flat_ex_q]) ... Recursive call - (pattern {.#Apply (|recursion_dummy|) {.#Parameter 0}}) + {.#Apply (|recursion_dummy|) {.#Parameter 0}} (product.left type_function_info) - (pattern {.#Apply (|recursion_dummy|) {.#UnivQ _ body}}) + {.#Apply (|recursion_dummy|) {.#UnivQ _ body}} (|> (type_definition' nestable? level arity type_function_info tags module body) (text.all_split_by \n) (list#each (text.prefix " ")) diff --git a/stdlib/source/library/lux/ffi.lux b/stdlib/source/library/lux/ffi.lux index e204a0a4c..f145b56cb 100644 --- a/stdlib/source/library/lux/ffi.lux +++ b/stdlib/source/library/lux/ffi.lux @@ -722,7 +722,7 @@ (.function (_ state) (let [ [name phase archive state]] (case inputs - (pattern ) + _ @@ -782,10 +782,10 @@ (def (pairs it) (All (_ a) (-> (List a) (List [a a]))) (case it - (pattern (list.partial left right tail)) + (list.partial left right tail) (list.partial [left right] (pairs tail)) - (pattern (list)) + (list) (list) _ @@ -798,7 +798,7 @@ [[state output] (monad.mix ! (.function (_ [key value] [state output]) (case key - (pattern (text_synthesis key)) + (text_synthesis key) (do try.monad [[state value] (phase archive value state)] (in [state (list.partial [key value] output)])) diff --git a/stdlib/source/library/lux/ffi.old.lux b/stdlib/source/library/lux/ffi.old.lux index 802c3ba9a..99158d8a9 100644 --- a/stdlib/source/library/lux/ffi.old.lux +++ b/stdlib/source/library/lux/ffi.old.lux @@ -1644,7 +1644,7 @@ size .any]) (case type (^.with_template [ ] - [(pattern {#GenericClass (list)}) + [{#GenericClass (list)} (in (list (` ( (, size)))))]) (["boolean" "jvm znewarray"] ["byte" "jvm bnewarray"] diff --git a/stdlib/source/library/lux/math.lux b/stdlib/source/library/lux/math.lux index 2bda65168..eac02fe80 100644 --- a/stdlib/source/library/lux/math.lux +++ b/stdlib/source/library/lux/math.lux @@ -83,10 +83,10 @@ _ (type.inference :it:) :it: (type.check (check.identity (list) $it))] (case (list.reversed operands) - (pattern (list single)) + (list single) (in single) - (pattern (list)) + (list) (`` (cond (check.subsumes? .I64 :it:) (phase.except ..no_arithmetic_for [:it:]) @@ -99,7 +99,7 @@ ... else (phase.except ..no_arithmetic_for [:it:]))) - (pattern (list.partial last prevs)) + (list.partial last prevs) (`` (cond (check.subsumes? .I64 :it:) (phase.except ..no_arithmetic_for [:it:]) diff --git a/stdlib/source/library/lux/math/number/frac.lux b/stdlib/source/library/lux/math/number/frac.lux index f4048ebc8..4601d9ffa 100644 --- a/stdlib/source/library/lux/math/number/frac.lux +++ b/stdlib/source/library/lux/math/number/frac.lux @@ -720,13 +720,13 @@ (case [(is Nat (..exponent it)) (is Nat (..mantissa it)) (is Nat (..sign it))] - (pattern [(static ..special_exponent_bits) 0 0]) + [(static ..special_exponent_bits) 0 0] ..positive_infinity - (pattern [(static ..special_exponent_bits) 0 1]) + [(static ..special_exponent_bits) 0 1] ..negative_infinity - (pattern [(static ..special_exponent_bits) _ _]) + [(static ..special_exponent_bits) _ _] ..not_a_number ... Positive zero diff --git a/stdlib/source/library/lux/math/number/int.lux b/stdlib/source/library/lux/math/number/int.lux index 33c82109e..3eb21d465 100644 --- a/stdlib/source/library/lux/math/number/int.lux +++ b/stdlib/source/library/lux/math/number/int.lux @@ -221,13 +221,13 @@ (let [input_size ("lux text size" repr)] (if (//nat.> 1 input_size) (case ("lux text clip" 0 1 repr) - (pattern (static ..+sign)) + (static ..+sign) (|> repr ("lux text clip" 1 (-- input_size)) (at decoded) (at try.functor each (|>> .int))) - (pattern (static ..-sign)) + (static ..-sign) (|> repr ("lux text clip" 1 (-- input_size)) (at decoded) diff --git a/stdlib/source/library/lux/math/number/nat.lux b/stdlib/source/library/lux/math/number/nat.lux index 5f63ffb78..75bf0fe2b 100644 --- a/stdlib/source/library/lux/math/number/nat.lux +++ b/stdlib/source/library/lux/math/number/nat.lux @@ -191,8 +191,8 @@ (def (binary_value digit) (-> Nat (Maybe Nat)) (case digit - (pattern (char "0")) {.#Some 0} - (pattern (char "1")) {.#Some 1} + (char "0") {.#Some 0} + (char "1") {.#Some 1} _ {.#None})) (def (octal_character value) @@ -211,14 +211,14 @@ (def (octal_value digit) (-> Nat (Maybe Nat)) (case digit - (pattern (char "0")) {.#Some 0} - (pattern (char "1")) {.#Some 1} - (pattern (char "2")) {.#Some 2} - (pattern (char "3")) {.#Some 3} - (pattern (char "4")) {.#Some 4} - (pattern (char "5")) {.#Some 5} - (pattern (char "6")) {.#Some 6} - (pattern (char "7")) {.#Some 7} + (char "0") {.#Some 0} + (char "1") {.#Some 1} + (char "2") {.#Some 2} + (char "3") {.#Some 3} + (char "4") {.#Some 4} + (char "5") {.#Some 5} + (char "6") {.#Some 6} + (char "7") {.#Some 7} _ {.#None})) (def (decimal_character value) @@ -239,16 +239,16 @@ (def (decimal_value digit) (-> Nat (Maybe Nat)) (case digit - (pattern (char "0")) {.#Some 0} - (pattern (char "1")) {.#Some 1} - (pattern (char "2")) {.#Some 2} - (pattern (char "3")) {.#Some 3} - (pattern (char "4")) {.#Some 4} - (pattern (char "5")) {.#Some 5} - (pattern (char "6")) {.#Some 6} - (pattern (char "7")) {.#Some 7} - (pattern (char "8")) {.#Some 8} - (pattern (char "9")) {.#Some 9} + (char "0") {.#Some 0} + (char "1") {.#Some 1} + (char "2") {.#Some 2} + (char "3") {.#Some 3} + (char "4") {.#Some 4} + (char "5") {.#Some 5} + (char "6") {.#Some 6} + (char "7") {.#Some 7} + (char "8") {.#Some 8} + (char "9") {.#Some 9} _ {.#None})) (def (hexadecimal_character value) @@ -276,12 +276,15 @@ (-> Nat (Maybe Nat)) (case digit (^.with_template [ ] - [(pattern (char )) {.#Some }]) + [(char ) + {.#Some }]) (["0" 0] ["1" 1] ["2" 2] ["3" 3] ["4" 4] ["5" 5] ["6" 6] ["7" 7] ["8" 8] ["9" 9]) (^.with_template [ ] - [(^.or (pattern (char )) (pattern (char ))) {.#Some }]) + [(^.or (char ) + (char )) + {.#Some }]) (["a" "A" 10] ["b" "B" 11] ["c" "C" 12] ["d" "D" 13] ["e" "E" 14] ["f" "F" 15]) _ {.#None})) diff --git a/stdlib/source/library/lux/math/number/rev.lux b/stdlib/source/library/lux/math/number/rev.lux index 03e8e9684..1d164f539 100644 --- a/stdlib/source/library/lux/math/number/rev.lux +++ b/stdlib/source/library/lux/math/number/rev.lux @@ -249,7 +249,7 @@ (let [repr_size ("lux text size" repr)] (if (//nat.> 1 repr_size) (case ("lux text char" 0 repr) - (pattern (char ".")) + (char ".") (case (at decoded (..decimals repr)) {try.#Success output} {try.#Success (.rev output)} diff --git a/stdlib/source/library/lux/meta/macro.lux b/stdlib/source/library/lux/meta/macro.lux index 86e9fe57d..464329a25 100644 --- a/stdlib/source/library/lux/meta/macro.lux +++ b/stdlib/source/library/lux/meta/macro.lux @@ -116,7 +116,7 @@ (def .public with_symbols (.macro (_ tokens) (case tokens - (pattern (list [_ {.#Tuple symbols}] body)) + (list [_ {.#Tuple symbols}] body) (do [! //.monad] [symbol_names (monad.each ! ..local symbols) .let [symbol_defs (list#conjoint (list#each (is (-> Text (List Code)) @@ -134,7 +134,7 @@ (do //.monad [token+ (..expansion token)] (case token+ - (pattern (list token')) + (list token') (in token') _ @@ -148,11 +148,11 @@ macro_name [module short]] (case (is (Maybe [Bit Code]) (case tokens - (pattern (list [_ {.#Text "omit"}] - token)) + (list [_ {.#Text "omit"}] + token) {.#Some [#1 token]} - (pattern (list token)) + (list token) {.#Some [#0 token]} _ @@ -180,7 +180,7 @@ (def .public times (.macro (_ tokens) (case tokens - (pattern (list.partial [_ {.#Nat times}] terms)) + (list.partial [_ {.#Nat times}] terms) (loop (again [times times before terms]) (case times diff --git a/stdlib/source/library/lux/meta/macro/pattern.lux b/stdlib/source/library/lux/meta/macro/pattern.lux index affa8273a..7e3b30d9d 100644 --- a/stdlib/source/library/lux/meta/macro/pattern.lux +++ b/stdlib/source/library/lux/meta/macro/pattern.lux @@ -2,14 +2,14 @@ [library [lux (.except or let with_template |> `)]]) -(def partial_list - (`` ("lux in-module" (,, (static .prelude)) .partial_list))) +(def list#partial + (`` ("lux in-module" (,, (static .prelude)) .list#partial))) (def locally (macro (_ tokens lux) (.let [[prelude _] (symbol ._)] (case tokens - (pattern (list [@ {.#Symbol ["" name]}])) + (list [@ {.#Symbol ["" name]}]) {.#Right [lux (list (.` ("lux in-module" (, [@ {.#Text prelude}]) (, [@ {.#Symbol [prelude name]}]))))]} @@ -73,107 +73,112 @@ ) (def .public or - (macro (_ tokens) - (case tokens - (pattern (partial_list [_ {.#Form patterns}] body branches)) - (case patterns - {.#End} - (failure (..wrong_syntax_error (symbol ..or))) - - _ - (.let [pairs (.|> patterns - (list#each (function (_ pattern) (list pattern body))) - list#conjoint)] - (meta#in (list#composite pairs branches)))) - _ - (failure (..wrong_syntax_error (symbol ..or)))))) + (pattern + (macro (_ tokens) + (case tokens + (list#partial [_ {.#Form patterns}] body branches) + (case patterns + {.#End} + (failure (..wrong_syntax_error (symbol ..or))) + + _ + (.let [pairs (.|> patterns + (list#each (function (_ pattern) (list pattern body))) + list#conjoint)] + (meta#in (list#composite pairs branches)))) + _ + (failure (..wrong_syntax_error (symbol ..or))))))) (def .public with_template - (macro (_ tokens) - (case tokens - (pattern (partial_list [_ {.#Form (list [_ {.#Tuple bindings}] - [_ {.#Tuple templates}])}] - [_ {.#Form data}] - branches)) - (case (is (Maybe (List Code)) - (do maybe#monad - [bindings' (monad#each maybe#monad symbol_short bindings) - data' (monad#each maybe#monad tuple_list data)] - (.let [num_bindings (list#size bindings')] - (if (every? (|>> ("lux i64 =" num_bindings)) - (list#each list#size data')) - (.let [apply (is (-> Replacement_Environment (List Code)) - (function (_ env) (list#each (realized_template env) templates)))] - (.|> data' - (list#each (function#composite apply (replacement_environment bindings'))) - list#conjoint - in)) - {.#None})))) - {.#Some output} - (meta#in (list#composite output branches)) - - {.#None} - (failure (..wrong_syntax_error (symbol ..with_template)))) - - _ - (failure (..wrong_syntax_error (symbol ..with_template)))))) + (pattern + (macro (_ tokens) + (case tokens + (list#partial [_ {.#Form (list [_ {.#Tuple bindings}] + [_ {.#Tuple templates}])}] + [_ {.#Form data}] + branches) + (case (is (Maybe (List Code)) + (do maybe#monad + [bindings' (monad#each maybe#monad symbol_short bindings) + data' (monad#each maybe#monad tuple_list data)] + (.let [num_bindings (list#size bindings')] + (if (every? (|>> ("lux i64 =" num_bindings)) + (list#each list#size data')) + (.let [apply (is (-> Replacement_Environment (List Code)) + (function (_ env) (list#each (realized_template env) templates)))] + (.|> data' + (list#each (function#composite apply (replacement_environment bindings'))) + list#conjoint + in)) + {.#None})))) + {.#Some output} + (meta#in (list#composite output branches)) + + {.#None} + (failure (..wrong_syntax_error (symbol ..with_template)))) + + _ + (failure (..wrong_syntax_error (symbol ..with_template))))))) (def .public multi - (macro (_ tokens) - (case tokens - (pattern (partial_list [_meta {.#Form levels}] body next_branches)) - (do meta#monad - [mlc (multi_level_case^ levels) - .let [initial_bind? (case mlc - [[_ {.#Symbol _}] _] - #1 - - _ - #0)] - expected ..expected_type - g!temp (..generated_symbol "temp")] - (in (list g!temp - (.` ({{.#Some (, g!temp)} - (, g!temp) - - {.#None} - (.case (, g!temp) - (,* next_branches))} - ("lux type check" {.#Apply (, (type_code expected)) Maybe} - (.case (, g!temp) - (,* (multi_level_case$ g!temp [mlc body])) - - (,* (if initial_bind? - (list) - (list g!temp (.` {.#None}))))))))))) - - _ - (failure (..wrong_syntax_error (symbol ..multi)))))) + (pattern + (macro (_ tokens) + (case tokens + (list#partial [_meta {.#Form levels}] body next_branches) + (do meta#monad + [mlc (multi_level_case^ levels) + .let [initial_bind? (case mlc + [[_ {.#Symbol _}] _] + #1 + + _ + #0)] + expected ..expected_type + g!temp (..generated_symbol "temp")] + (in (list g!temp + (.` ({{.#Some (, g!temp)} + (, g!temp) + + {.#None} + (.case (, g!temp) + (,* next_branches))} + ("lux type check" {.#Apply (, (type_code expected)) Maybe} + (.case (, g!temp) + (,* (multi_level_case$ g!temp [mlc body])) + + (,* (if initial_bind? + (list) + (list g!temp (.` {.#None}))))))))))) + + _ + (failure (..wrong_syntax_error (symbol ..multi))))))) (def .public let - (macro (_ tokens) - (case tokens - (pattern (partial_list [_meta {.#Form (list [_ {.#Symbol ["" name]}] pattern)}] body branches)) - (.let [g!whole (local$ name)] - (meta#in (partial_list g!whole - (.` (case (, g!whole) (, pattern) (, body))) - branches))) - - _ - (failure (..wrong_syntax_error (symbol ..let)))))) + (pattern + (macro (_ tokens) + (case tokens + (list#partial [_meta {.#Form (list [_ {.#Symbol ["" name]}] pattern)}] body branches) + (.let [g!whole (local$ name)] + (meta#in (list#partial g!whole + (.` (case (, g!whole) (, pattern) (, body))) + branches))) + + _ + (failure (..wrong_syntax_error (symbol ..let))))))) (def .public |> - (macro (_ tokens) - (case tokens - (pattern (partial_list [_meta {.#Form (list [_ {.#Symbol ["" name]}] [_ {.#Tuple steps}])}] body branches)) - (.let [g!name (local$ name)] - (meta#in (partial_list g!name - (.` (.let [(, g!name) (.|> (, g!name) (,* steps))] - (, body))) - branches))) - - _ - (failure (..wrong_syntax_error (symbol ..|>)))))) + (pattern + (macro (_ tokens) + (case tokens + (list#partial [_meta {.#Form (list [_ {.#Symbol ["" name]}] [_ {.#Tuple steps}])}] body branches) + (.let [g!name (local$ name)] + (meta#in (list#partial g!name + (.` (.let [(, g!name) (.|> (, g!name) (,* steps))] + (, body))) + branches))) + + _ + (failure (..wrong_syntax_error (symbol ..|>))))))) (def (name$ [module name]) (-> Symbol Code) @@ -240,17 +245,18 @@ ))) (def .public ` - (macro (_ tokens) - (case tokens - (pattern (partial_list [_meta {.#Form (list template)}] body branches)) - (do meta#monad - [pattern (untemplated_pattern template)] - (in (partial_list pattern body branches))) - - (pattern (list template)) - (do meta#monad - [pattern (untemplated_pattern template)] - (in (list pattern))) - - _ - (failure (..wrong_syntax_error (symbol ..`)))))) + (pattern + (macro (_ tokens) + (case tokens + (list#partial [_meta {.#Form (list template)}] body branches) + (do meta#monad + [pattern (untemplated_pattern template)] + (in (list#partial pattern body branches))) + + (list template) + (do meta#monad + [pattern (untemplated_pattern template)] + (in (list pattern))) + + _ + (failure (..wrong_syntax_error (symbol ..`))))))) diff --git a/stdlib/source/library/lux/meta/symbol.lux b/stdlib/source/library/lux/meta/symbol.lux index cea58ae51..e46516bb9 100644 --- a/stdlib/source/library/lux/meta/symbol.lux +++ b/stdlib/source/library/lux/meta/symbol.lux @@ -52,10 +52,10 @@ (def (decoded input) (case (text.all_split_by ..separator input) - (pattern (list short)) + (list short) {.#Right ["" short]} - (pattern (list module short)) + (list module short) {.#Right [module short]} _ diff --git a/stdlib/source/library/lux/meta/type.lux b/stdlib/source/library/lux/meta/type.lux index 1664ce98a..e71bafc42 100644 --- a/stdlib/source/library/lux/meta/type.lux +++ b/stdlib/source/library/lux/meta/type.lux @@ -367,7 +367,7 @@ (def .public (flat_array type) (-> Type [Nat Type]) (case type - (^.multi (pattern {.#Primitive name (list element_type)}) + (^.multi {.#Primitive name (list element_type)} (text#= array.type_name name)) (.let [[depth element_type] (flat_array element_type)] [(++ depth) element_type]) diff --git a/stdlib/source/library/lux/meta/type/check.lux b/stdlib/source/library/lux/meta/type/check.lux index 60c1f0e5c..a08d36625 100644 --- a/stdlib/source/library/lux/meta/type/check.lux +++ b/stdlib/source/library/lux/meta/type/check.lux @@ -388,20 +388,20 @@ (do [! ..monad] [ring (..ring' @)] (case ring - (pattern (list)) + (list) (in []) - (pattern (list @me)) + (list @me) (erase! @me) - (pattern (list @other @me)) + (list @other @me) (do ! [_ (re_bind' {.#None} @other)] (erase! @me)) - (pattern (list.partial @prev _)) + (list.partial @prev _) (case (list.reversed ring) - (pattern (list.partial @me @next _)) + (list.partial @me @next _) (do ! [_ (re_bind {.#Var @next} @prev) _ (re_bind {.#Var @prev} @next)] @@ -795,7 +795,7 @@ {.#Var @it} (case aliases - (pattern (list)) + (list) (do ..monad [?actualT (..peek @it)] (case ?actualT diff --git a/stdlib/source/library/lux/target/jvm/reflection.lux b/stdlib/source/library/lux/target/jvm/reflection.lux index 45a33bb52..2f7ca93ae 100644 --- a/stdlib/source/library/lux/target/jvm/reflection.lux +++ b/stdlib/source/library/lux/target/jvm/reflection.lux @@ -290,7 +290,7 @@ (def .public (correspond class type) (-> (java/lang/Class java/lang/Object) Type (Try Mapping)) (case type - (pattern {.#Primitive (static array.type_name) (list :member:)}) + {.#Primitive (static array.type_name) (list :member:)} (if (java/lang/Class::isArray class) (correspond (java/lang/Class::getComponentType class) :member:) diff --git a/stdlib/source/library/lux/time/day.lux b/stdlib/source/library/lux/time/day.lux index f50c79af1..10c0a6498 100644 --- a/stdlib/source/library/lux/time/day.lux +++ b/stdlib/source/library/lux/time/day.lux @@ -115,7 +115,7 @@ (def (decoded value) (case (text#composite "#" value) (^.with_template [] - [(pattern (template.text [])) + [(template.text []) {try.#Success {}}]) ([..#Monday] [..#Tuesday] diff --git a/stdlib/source/library/lux/time/month.lux b/stdlib/source/library/lux/time/month.lux index 385106ea5..85f40252c 100644 --- a/stdlib/source/library/lux/time/month.lux +++ b/stdlib/source/library/lux/time/month.lux @@ -235,7 +235,7 @@ (def (decoded value) (case (text#composite "#" value) (^.with_template [] - [(pattern (template.text [])) + [(template.text []) {try.#Success {}}]) ([..#January] [..#February] 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 2442874a0..b975614df 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/analysis.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis.lux @@ -1,6 +1,6 @@ (.require [library - [lux (.except Tuple Variant nat int rev case local except) + [lux (.except Tuple Variant Pattern nat int rev case local except) [abstract [equivalence (.only Equivalence)] [hash (.only Hash)] 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 aefb5abc7..dd5fde4f2 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 @@ -1,6 +1,6 @@ (.require [library - [lux (.except Variant) + [lux (.except Variant Pattern) [abstract [equivalence (.except)] ["[0]" monad (.only do)]] @@ -191,7 +191,8 @@ ... their sub-patterns. {//pattern.#Complex {//complex.#Tuple membersP+}} (case (list.reversed membersP+) - (^.or (pattern (list)) (pattern (list _))) + (^.or (list) + (list _)) (exception.except ..invalid_tuple [(list.size membersP+)]) {.#Item lastP prevsP+} 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 d25fb1f8a..f91c4a145 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 @@ -161,7 +161,7 @@ [[just_before vars :inference: terms] (general' (list) archive analyse inferT args)] (in [:inference: terms]) ... (case vars - ... (pattern (list)) + ... (list) ... (in [:inference: terms]) ... _ diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/macro.lux b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/macro.lux index 2e2982214..9a5de364f 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/macro.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/macro.lux @@ -49,7 +49,7 @@ (do meta.monad [expansion (..expansion expander name macro inputs)] (case expansion - (pattern (list single)) + (list single) (in single) _ diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/pattern.lux b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/pattern.lux index 52c5de8fc..daf608222 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/pattern.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/pattern.lux @@ -1,6 +1,6 @@ (.require [library - [lux (.except nat int rev) + [lux (.except Pattern nat int rev) [abstract [equivalence (.only Equivalence)]] [data diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis.lux index 594626581..30e4a1360 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis.lux @@ -44,7 +44,7 @@ (template (_ analysis archive tag values) ... (-> Phase Archive Symbol (List Code) (Operation Analysis)) [(case values - (pattern (list value)) + (list value) (/complex.variant analysis tag archive value) _ @@ -54,7 +54,7 @@ (template (_ analysis archive lefts right? values) ... (-> Phase Archive Nat Bit (List Code) (Operation Analysis)) [(case values - (pattern (list value)) + (list value) (/complex.sum analysis lefts right? archive value) _ @@ -77,7 +77,7 @@ [[functionT functionA] (/type.inferring (analysis archive functionC))] (case functionA - (pattern (/.constant def_name)) + (/.constant def_name) (do ! [?macro (//extension.lifted (meta.macro def_name))] (case ?macro 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 65d951e0a..6356d32c5 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 @@ -1,6 +1,6 @@ (.require [library - [lux (.except case) + [lux (.except Pattern case) [abstract ["[0]" monad (.only do)]] [control @@ -246,7 +246,7 @@ [Text {.#Text pattern_value} {/simple.#Text pattern_value}] [Any {.#Tuple {.#End}} {/simple.#Unit}]) - (pattern [location {.#Tuple (list singleton)}]) + [location {.#Tuple (list singleton)}] (pattern_analysis {.#None} :input: singleton next) [location {.#Tuple sub_patterns}] @@ -274,7 +274,7 @@ _ (in []))] (.case members - (pattern (list singleton)) + (list singleton) (pattern_analysis {.#None} :input: singleton next) _ @@ -283,7 +283,7 @@ {.#None} (..tuple_pattern_analysis pattern_analysis :input: sub_patterns next)))) - (pattern [location {.#Variant (list.partial [_ {.#Nat lefts}] [_ {.#Bit right?}] values)}]) + [location {.#Variant (list.partial [_ {.#Nat lefts}] [_ {.#Bit right?}] values)}] (/.with_location location (do ///.monad [[@ex_var+ :input:'] (/type.check (..tuple :input:))] @@ -324,7 +324,7 @@ _ (/.except ..mismatch [:input:' pattern])))) - (pattern [location {.#Variant (list.partial [_ {.#Symbol tag}] values)}]) + [location {.#Variant (list.partial [_ {.#Symbol tag}] values)}] (/.with_location location (do ///.monad [tag (///extension.lifted (meta.normal tag)) 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 2ee8cae7d..d7b26aa8f 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 @@ -294,14 +294,14 @@ output (is (List [Symbol Code]) {.#End})]) (case input - (pattern (list.partial [_ {.#Symbol ["" slotH]}] valueH tail)) + (list.partial [_ {.#Symbol ["" slotH]}] valueH tail) (if pattern_matching? (///#in {.#None}) (do ///.monad [slotH (///extension.lifted (meta.normal ["" slotH]))] (again tail {.#Item [slotH valueH] output}))) - (pattern (list.partial [_ {.#Symbol slotH}] valueH tail)) + (list.partial [_ {.#Symbol slotH}] valueH tail) (do ///.monad [slotH (///extension.lifted (meta.normal slotH))] (again tail {.#Item [slotH valueH] output})) @@ -386,13 +386,13 @@ (def .public (record analyse archive members) (-> Phase Archive (List Code) (Operation Analysis)) (case members - (pattern (list)) + (list) //simple.unit - (pattern (list singletonC)) + (list singletonC) (analyse archive singletonC) - (pattern (list [_ {.#Symbol pseudo_slot}] singletonC)) + (list [_ {.#Symbol pseudo_slot}] singletonC) (do [! ///.monad] [head_k (///extension.lifted (meta.normal pseudo_slot)) slot (///extension.lifted (meta.try (meta.slot head_k)))] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/declaration.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/declaration.lux index 806308519..86602280e 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/declaration.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/declaration.lux @@ -90,17 +90,17 @@ extension_eval (as Eval (wrapper (as_expected compiler_eval)))] _ (//.with (has [//extension.#state /.#analysis /.#state //extension.#state .#eval] extension_eval state))] (case code - (pattern [_ {.#Form (list.partial [_ {.#Text name}] inputs)}]) + [_ {.#Form (list.partial [_ {.#Text name}] inputs)}] (//extension.apply archive again [name inputs]) - (pattern [_ {.#Form (list.partial macro inputs)}]) + [_ {.#Form (list.partial macro inputs)}] (do ! [expansion (/.lifted_analysis (do ! [macroA (<| (///analysis/type.expecting Macro) (analysis archive macro))] (case macroA - (pattern (///analysis.constant macro_name)) + (///analysis.constant macro_name) (do ! [?macro (//extension.lifted (meta.macro macro_name)) macro (case ?macro @@ -114,7 +114,7 @@ _ (//.except ..invalid_macro_call code))))] (case expansion - (pattern (list.partial referrals)) + (list.partial referrals) (|> (again archive ) (at ! each (revised /.#referrals (list#composite referrals)))) 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 39dc0ac97..eb88d937f 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 @@ -410,7 +410,7 @@ {.#None} (/////analysis.except ..non_jvm_type luxT)) - (pattern (lux_array_type elemT _)) + (lux_array_type elemT _) (phase#each jvm.array (jvm_type elemT)) {.#Primitive class parametersT} @@ -461,7 +461,7 @@ (-> (Type Primitive) Handler) (function (_ extension_name analyse archive args) (case args - (pattern (list arrayC)) + (list arrayC) (do phase.monad [_ (typeA.inference ..int) arrayA (<| (typeA.expecting {.#Primitive (|> (jvm.array primitive_type) @@ -477,7 +477,7 @@ Handler (function (_ extension_name analyse archive args) (case args - (pattern (list arrayC)) + (list arrayC) (<| typeA.with_var (function (_ [@read :read:])) typeA.with_var @@ -499,7 +499,7 @@ (-> (Type Primitive) Handler) (function (_ extension_name analyse archive args) (case args - (pattern (list lengthC)) + (list lengthC) (do phase.monad [lengthA (<| (typeA.expecting ..int) (analyse archive lengthC)) @@ -514,7 +514,7 @@ Handler (function (_ extension_name analyse archive args) (case args - (pattern (list lengthC)) + (list lengthC) (do phase.monad [lengthA (<| (typeA.expecting ..int) (analyse archive lengthC)) @@ -535,7 +535,7 @@ (def (check_parameter objectT) (-> .Type (Operation (Type Parameter))) (case objectT - (pattern (lux_array_type elementT _)) + (lux_array_type elementT _) (/////analysis.except ..non_parameter objectT) {.#Primitive name parameters} @@ -631,7 +631,7 @@ ... else (phase#in (jvm.class name (list))))) - (pattern (lux_array_type elementT _)) + (lux_array_type elementT _) (|> elementT check_jvm (phase#each jvm.array)) @@ -698,7 +698,7 @@ (-> .Type (Type Primitive) Handler) (function (_ extension_name analyse archive args) (case args - (pattern (list idxC arrayC)) + (list idxC arrayC) (do phase.monad [_ (typeA.inference lux_type) idxA (<| (typeA.expecting ..int) @@ -715,7 +715,7 @@ Handler (function (_ extension_name analyse archive args) (case args - (pattern (list idxC arrayC)) + (list idxC arrayC) (<| typeA.with_var (function (_ [@read :read:])) typeA.with_var @@ -742,7 +742,7 @@ (list)}] (function (_ extension_name analyse archive args) (case args - (pattern (list idxC valueC arrayC)) + (list idxC valueC arrayC) (do phase.monad [_ (typeA.inference array_type) idxA (<| (typeA.expecting ..int) @@ -762,7 +762,7 @@ Handler (function (_ extension_name analyse archive args) (case args - (pattern (list idxC valueC arrayC)) + (list idxC valueC arrayC) (<| typeA.with_var (function (_ [@read :read:])) typeA.with_var @@ -840,7 +840,7 @@ Handler (function (_ extension_name analyse archive args) (case args - (pattern (list)) + (list) (do phase.monad [expectedT (///.lifted meta.expected_type) [_ :object:] (check_object expectedT) @@ -854,7 +854,7 @@ Handler (function (_ extension_name analyse archive args) (case args - (pattern (list objectC)) + (list objectC) (do phase.monad [_ (typeA.inference .Bit) [objectT objectA] (typeA.inferring @@ -869,7 +869,7 @@ Handler (function (_ extension_name analyse archive args) (case args - (pattern (list monitorC exprC)) + (list monitorC exprC) (do phase.monad [[monitorT monitorA] (typeA.inferring (analyse archive monitorC)) @@ -884,7 +884,7 @@ (-> java/lang/ClassLoader Handler) (function (_ extension_name analyse archive args) (case args - (pattern (list exceptionC)) + (list exceptionC) (do phase.monad [_ (typeA.inference Nothing) [exceptionT exceptionA] (typeA.inferring @@ -904,7 +904,7 @@ (-> java/lang/ClassLoader Handler) (function (_ extension_name analyse archive args) (case args - (pattern (list classC)) + (list classC) (case classC [_ {.#Text class}] (do phase.monad @@ -961,7 +961,7 @@ (def (inheritance_candidate_parents class_loader fromT target_class toT fromC) (-> java/lang/ClassLoader .Type (java/lang/Class java/lang/Object) .Type Code (Operation (List [[Text .Type] Bit]))) (case fromT - (pattern {.#Primitive _ (list.partial self_classT super_classT super_interfacesT+)}) + {.#Primitive _ (list.partial self_classT super_classT super_interfacesT+)} (monad.each phase.monad (function (_ superT) (do [! phase.monad] @@ -978,7 +978,7 @@ (-> java/lang/ClassLoader Handler) (function (_ extension_name analyse archive args) (case args - (pattern (list fromC)) + (list fromC) (do [! phase.monad] [toT (///.lifted meta.expected_type) target_name (at ! each ..reflection (check_jvm toT)) 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 367240a34..005ecde81 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 @@ -139,7 +139,7 @@ Handler (function (_ extension_name analyse archive args) (case args - (pattern (list opC)) + (list opC) (<| typeA.with_var (function (_ [@var :var:])) (do [! ////.monad] @@ -156,7 +156,7 @@ Handler (function (_ extension_name analyse archive argsC+) (case argsC+ - (pattern (list [_ {.#Text module_name}] exprC)) + (list [_ {.#Text module_name}] exprC) (////analysis.with_current_module module_name (analyse archive exprC)) @@ -167,7 +167,7 @@ (-> Eval Handler) (function (_ extension_name analyse archive args) (case args - (pattern (list typeC valueC)) + (list typeC valueC) (do [! ////.monad] [actualT (at ! each (|>> (as Type)) (eval archive Type typeC)) @@ -182,7 +182,7 @@ (-> Eval Handler) (function (_ extension_name analyse archive args) (case args - (pattern (list typeC valueC)) + (list typeC valueC) (do [! ////.monad] [actualT (at ! each (|>> (as Type)) (eval archive Type typeC)) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/declaration/lux.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/declaration/lux.lux index 8c5f5dbc8..c992c73a8 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/declaration/lux.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/declaration/lux.lux @@ -127,7 +127,7 @@ [interim_artifacts codeG] (/////generation.with_interim_artifacts archive (generate archive codeS)) .let [@abstraction (case codeS - (pattern (/////synthesis.function/abstraction [env arity body])) + (/////synthesis.function/abstraction [env arity body]) (|> interim_artifacts list.last (maybe#each (|>> [arity]))) @@ -246,7 +246,7 @@ (-> Expander /////analysis.Bundle Handler) (function (_ extension_name phase archive inputsC+) (case inputsC+ - (pattern (list [_ {.#Symbol ["" short_name]}] valueC exported?C)) + (list [_ {.#Symbol ["" short_name]}] valueC exported?C) (do phase.monad [current_module (/////declaration.lifted_analysis (///.lifted meta.current_module_name)) @@ -426,7 +426,7 @@ (Handler anchor expression declaration))) (function (handler extension_name phase archive inputsC+) (case inputsC+ - (pattern (list nameC valueC)) + (list nameC valueC) (do phase.monad [target_platform (/////declaration.lifted_analysis (///.lifted meta.target)) @@ -434,11 +434,11 @@ [_ handlerV] ( archive (as Text name) (let [raw_type (type_literal )] (case target_platform - (^.or (pattern (static @.jvm)) - (pattern (static @.js))) + (^.or (static @.jvm) + (static @.js)) raw_type - (pattern (static @.python)) + (static @.python) (swapped binary.Binary Binary|Python raw_type) _ @@ -519,7 +519,7 @@ (-> (Program expression declaration) (Handler anchor expression declaration))) (function (handler extension_name phase archive inputsC+) (case inputsC+ - (pattern (list programC)) + (list programC) (do phase.monad [state (///.lifted phase.state) .let [analyse (the [/////declaration.#analysis /////declaration.#phase] state) 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 3205b9933..582107b3c 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 @@ -109,7 +109,7 @@ (in (as Statement body))) (^.with_template [] - [(pattern ( value)) + [( value) (/////#each _.return (expression archive synthesis))]) ([synthesis.bit] [synthesis.i64] @@ -121,30 +121,30 @@ [synthesis.function/apply]) (^.with_template [] - [(pattern { value}) + [{ value} (/////#each _.return (expression archive synthesis))]) ([synthesis.#Reference] [synthesis.#Extension]) - (pattern (synthesis.branch/case case)) + (synthesis.branch/case case) (//case.case! statement expression archive case) - (pattern (synthesis.branch/exec it)) + (synthesis.branch/exec it) (//case.exec! statement expression archive it) - (pattern (synthesis.branch/let let)) + (synthesis.branch/let let) (//case.let! statement expression archive let) - (pattern (synthesis.branch/if if)) + (synthesis.branch/if if) (//case.if! statement expression archive if) - (pattern (synthesis.loop/scope scope)) + (synthesis.loop/scope scope) (//loop.scope! statement expression archive scope) - (pattern (synthesis.loop/again updates)) + (synthesis.loop/again updates) (//loop.again! statement expression archive updates) - (pattern (synthesis.function/abstraction abstraction)) + (synthesis.function/abstraction abstraction) (/////#each _.return (//function.function statement expression archive abstraction)) )) 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 b72b69b2c..0d0a38730 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 @@ -830,7 +830,7 @@ [1 _]) body - (pattern [2 {synthesis.#Control {synthesis.#Branch {synthesis.#Let _ 2 (synthesis.tuple (list _ hidden))}}}]) + [2 {synthesis.#Control {synthesis.#Branch {synthesis.#Let _ 2 (synthesis.tuple (list _ hidden))}}}] hidden [_ {synthesis.#Control {synthesis.#Branch {synthesis.#Case _ path}}}] @@ -839,7 +839,7 @@ {synthesis.#Seq _ next} (again next) - (pattern {synthesis.#Then (synthesis.tuple (list _ hidden))}) + {synthesis.#Then (synthesis.tuple (list _ hidden))} hidden _ @@ -1004,11 +1004,11 @@ (-> Path Path)) (function (again path) (case path - (pattern (synthesis.path/then bodyS)) + (synthesis.path/then bodyS) (synthesis.path/then (normalize bodyS)) (^.with_template [] - [(pattern { leftP rightP}) + [{ leftP rightP} { (again leftP) (again rightP)}]) ([synthesis.#Alt] [synthesis.#Seq]) @@ -1041,48 +1041,48 @@ (function (again body) (case body (^.with_template [] - [(pattern ) + [ body]) ([{synthesis.#Simple _}] [(synthesis.constant _)]) - (pattern (synthesis.variant [lefts right? sub])) + (synthesis.variant [lefts right? sub]) (synthesis.variant [lefts right? (again sub)]) - (pattern (synthesis.tuple members)) + (synthesis.tuple members) (synthesis.tuple (list#each again members)) - (pattern (synthesis.variable var)) + (synthesis.variable var) (|> mapping (dictionary.value body) (maybe.else var) synthesis.variable) - (pattern (synthesis.branch/case [inputS pathS])) + (synthesis.branch/case [inputS pathS]) (synthesis.branch/case [(again inputS) (normalize_path again pathS)]) - (pattern (synthesis.branch/exec [this that])) + (synthesis.branch/exec [this that]) (synthesis.branch/exec [(again this) (again that)]) - (pattern (synthesis.branch/let [inputS register outputS])) + (synthesis.branch/let [inputS register outputS]) (synthesis.branch/let [(again inputS) register (again outputS)]) - (pattern (synthesis.branch/if [testS thenS elseS])) + (synthesis.branch/if [testS thenS elseS]) (synthesis.branch/if [(again testS) (again thenS) (again elseS)]) - (pattern (synthesis.branch/get [path recordS])) + (synthesis.branch/get [path recordS]) (synthesis.branch/get [path (again recordS)]) - (pattern (synthesis.loop/scope [offset initsS+ bodyS])) + (synthesis.loop/scope [offset initsS+ bodyS]) (synthesis.loop/scope [offset (list#each again initsS+) (again bodyS)]) - (pattern (synthesis.loop/again updatesS+)) + (synthesis.loop/again updatesS+) (synthesis.loop/again (list#each again updatesS+)) - (pattern (synthesis.function/abstraction [environment arity bodyS])) + (synthesis.function/abstraction [environment arity bodyS]) (synthesis.function/abstraction [(list#each (function (_ captured) (case captured - (pattern (synthesis.variable var)) + (synthesis.variable var) (|> mapping (dictionary.value captured) (maybe.else var) @@ -1094,7 +1094,7 @@ arity bodyS]) - (pattern (synthesis.function/apply [functionS inputsS+])) + (synthesis.function/apply [functionS inputsS+]) (synthesis.function/apply [(again functionS) (list#each again inputsS+)]) {synthesis.#Extension [name inputsS+]} 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 abaf8d32f..00cd16e75 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 @@ -71,7 +71,7 @@ (in (as Statement body))) (^.with_template [] - [(pattern ( value)) + [( value) (/////#each _.return (expression archive synthesis))]) ([synthesis.bit] [synthesis.i64] @@ -83,32 +83,32 @@ [synthesis.function/apply]) (^.with_template [] - [(pattern { value}) + [{ value} (/////#each _.return (expression archive synthesis))]) ([synthesis.#Reference] [synthesis.#Extension]) - (pattern (synthesis.branch/case case)) + (synthesis.branch/case case) (//case.case! statement expression archive case) - (pattern (synthesis.branch/exec it)) + (synthesis.branch/exec it) (//case.exec! statement expression archive it) - (pattern (synthesis.branch/let let)) + (synthesis.branch/let let) (//case.let! statement expression archive let) - (pattern (synthesis.branch/if if)) + (synthesis.branch/if if) (//case.if! statement expression archive if) - (pattern (synthesis.loop/scope scope)) + (synthesis.loop/scope scope) (do /////.monad [[inits scope!] (//loop.scope! statement expression archive false scope)] (in scope!)) - (pattern (synthesis.loop/again updates)) + (synthesis.loop/again updates) (//loop.again! statement expression archive updates) - (pattern (synthesis.function/abstraction abstraction)) + (synthesis.function/abstraction abstraction) (/////#each _.return (//function.function statement expression archive abstraction)) )) 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 37ac2d627..6d42c51e7 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 @@ -56,7 +56,7 @@ (in (as (Statement Any) body))) (^.with_template [] - [(pattern ( value)) + [( value) (/////#each _.return (expression archive synthesis))]) ([synthesis.bit] [synthesis.i64] @@ -68,16 +68,16 @@ [synthesis.function/apply]) (^.with_template [] - [(pattern { value}) + [{ value} (/////#each _.return (expression archive synthesis))]) ([synthesis.#Reference] [synthesis.#Extension]) - (pattern (synthesis.branch/case case)) + (synthesis.branch/case case) (//case.case! false statement expression archive case) (^.with_template [ ] - [(pattern ( value)) + [( value) ( statement expression archive value)]) ([synthesis.branch/exec //case.exec!] [synthesis.branch/let //case.let!] @@ -85,7 +85,7 @@ [synthesis.loop/scope //loop.scope!] [synthesis.loop/again //loop.again!]) - (pattern (synthesis.function/abstraction abstraction)) + (synthesis.function/abstraction abstraction) (/////#each _.return (//function.function statement expression archive abstraction)) )) 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 95b08bf3c..944bcec7c 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 @@ -68,7 +68,7 @@ body))) (^.with_template [] - [(pattern ( value)) + [( value) (/////#each _.return (expression archive synthesis))]) ([synthesis.bit] [synthesis.i64] @@ -80,16 +80,16 @@ [synthesis.function/apply]) (^.with_template [] - [(pattern { value}) + [{ value} (/////#each _.return (expression archive synthesis))]) ([synthesis.#Reference] [synthesis.#Extension]) - (pattern (synthesis.branch/case case)) + (synthesis.branch/case case) (//case.case! false statement expression archive case) (^.with_template [ ] - [(pattern ( value)) + [( value) ( statement expression archive value)]) ([synthesis.branch/exec //case.exec!] [synthesis.branch/let //case.let!] @@ -97,7 +97,7 @@ [synthesis.loop/scope //loop.scope!] [synthesis.loop/again //loop.again!]) - (pattern (synthesis.function/abstraction abstraction)) + (synthesis.function/abstraction abstraction) (/////#each _.return (//function.function statement expression archive abstraction)) )) 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 8af11bb77..1168d5b8b 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 @@ -30,7 +30,7 @@ Phase (case synthesis (^.with_template [ ] - [(pattern ( value)) + [( value) (//////phase#in ( value))]) ([////synthesis.bit /primitive.bit] [////synthesis.i64 /primitive.i64] @@ -41,7 +41,7 @@ (//reference.reference /reference.system archive value) (^.with_template [ ] - [(pattern ( value)) + [( value) ( generate archive value)]) ([////synthesis.variant /structure.variant] [////synthesis.tuple /structure.tuple] 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 6059eddc2..c00fab798 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 @@ -141,7 +141,7 @@ (Generator [Var/1 _.Tag _.Tag Path]) (function (again [$output @done @fail pathP]) (.case pathP - (pattern (/////synthesis.path/then bodyS)) + (/////synthesis.path/then bodyS) (at ///////phase.monad each (function (_ outputV) (_.progn (list (_.setq $output outputV) @@ -190,40 +190,40 @@ [/////synthesis.#Text_Fork //primitive.text _.string=/2]) (^.with_template [ ] - [(pattern ( idx)) + [( idx) (///////phase#in ( @fail false idx {.#None})) - (pattern ( idx nextP)) + ( idx nextP) (|> nextP [$output @done @fail] again (at ///////phase.monad each (|>> {.#Some} ( @fail true idx))))]) ([/////synthesis.side/left /////synthesis.simple_left_side ..left_choice] [/////synthesis.side/right /////synthesis.simple_right_side ..right_choice]) - (pattern (/////synthesis.member/left 0)) + (/////synthesis.member/left 0) (///////phase#in (..push! (_.elt/2 [..peek (_.int +0)]))) (^.with_template [ ] - [(pattern ( lefts)) + [( lefts) (///////phase#in (|> ..peek ( (_.int (.int lefts))) ..push!))]) ([/////synthesis.member/left //runtime.tuple//left] [/////synthesis.member/right //runtime.tuple//right]) - (pattern (/////synthesis.!multi_pop nextP)) + (/////synthesis.!multi_pop nextP) (.let [[extra_pops nextP'] (////synthesis/case.count_pops nextP)] (do ///////phase.monad [next! (again [$output @done @fail nextP'])] (///////phase#in (_.progn (list (..multi_pop! (n.+ 2 extra_pops)) next!))))) - (pattern (/////synthesis.path/alt preP postP)) + (/////synthesis.path/alt preP postP) (do [! ///////phase.monad] [@otherwise (at ! each (|>> %.nat (format "lux_case_otherwise") _.tag) /////generation.next) pre! (again [$output @done @otherwise preP]) post! (again [$output @done @fail postP])] (in (..alternation @otherwise pre! post!))) - (pattern (/////synthesis.path/seq preP postP)) + (/////synthesis.path/seq preP postP) (do ///////phase.monad [pre! (again [$output @done @fail preP]) post! (again [$output @done @fail postP])] 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 9ab55a0a6..9d2c7e1db 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 @@ -40,7 +40,7 @@ (function ((, g!_) (, g!extension)) (function ((, g!_) (, g!name) (, g!phase) (, g!archive) (, g!inputs)) (case (, g!inputs) - (pattern (list (,* g!input+))) + (list (,* g!input+)) (do ///.monad [(,* (|> g!input+ (list#each (function (_ g!input) 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 907159f8a..bf12be34e 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 @@ -39,47 +39,47 @@ Phase (case synthesis (^.with_template [ ] - [(pattern ( value)) + [( value) (//////phase#in ( value))]) ([synthesis.bit /primitive.bit] [synthesis.i64 /primitive.i64] [synthesis.f64 /primitive.f64] [synthesis.text /primitive.text]) - (pattern (synthesis.variant variantS)) + (synthesis.variant variantS) (/structure.variant expression archive variantS) - (pattern (synthesis.tuple members)) + (synthesis.tuple members) (/structure.tuple expression archive members) {synthesis.#Reference value} (//reference.reference /reference.system archive value) - (pattern (synthesis.branch/case case)) + (synthesis.branch/case case) (/case.case ///extension/common.statement expression archive case) - (pattern (synthesis.branch/exec it)) + (synthesis.branch/exec it) (/case.exec expression archive it) - (pattern (synthesis.branch/let let)) + (synthesis.branch/let let) (/case.let expression archive let) - (pattern (synthesis.branch/if if)) + (synthesis.branch/if if) (/case.if expression archive if) - (pattern (synthesis.branch/get get)) + (synthesis.branch/get get) (/case.get expression archive get) - (pattern (synthesis.loop/scope scope)) + (synthesis.loop/scope scope) (/loop.scope ///extension/common.statement expression archive scope) - (pattern (synthesis.loop/again updates)) + (synthesis.loop/again updates) (//////phase.except ..cannot_recur_as_an_expression []) - (pattern (synthesis.function/abstraction abstraction)) + (synthesis.function/abstraction abstraction) (/function.function ///extension/common.statement expression archive abstraction) - (pattern (synthesis.function/apply application)) + (synthesis.function/apply application) (/function.apply expression archive application) {synthesis.#Extension extension} 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 24e27bd78..e93ef8b99 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 @@ -183,20 +183,20 @@ (-> Path (Operation (Maybe Statement)))) (.case pathP (^.with_template [ ] - [(pattern ( idx nextP)) + [( idx nextP) (|> nextP again (at ///////phase.monad each (|>> (_.then ( true idx)) {.#Some})))]) ([/////synthesis.simple_left_side ..left_choice] [/////synthesis.simple_right_side ..right_choice]) - (pattern (/////synthesis.member/left 0)) + (/////synthesis.member/left 0) (///////phase#in {.#Some (push_cursor! (_.at (_.i32 +0) ..peek_cursor))}) ... Extra optimization - (pattern (/////synthesis.path/seq - (/////synthesis.member/left 0) - (/////synthesis.!bind_top register thenP))) + (/////synthesis.path/seq + (/////synthesis.member/left 0) + (/////synthesis.!bind_top register thenP)) (do ///////phase.monad [then! (again thenP)] (in {.#Some (all _.then @@ -205,9 +205,9 @@ ... Extra optimization (^.with_template [ ] - [(pattern (/////synthesis.path/seq - ( lefts) - (/////synthesis.!bind_top register thenP))) + [(/////synthesis.path/seq + ( lefts) + (/////synthesis.!bind_top register thenP)) (do ///////phase.monad [then! (again thenP)] (in {.#Some (all _.then @@ -216,14 +216,14 @@ ([/////synthesis.member/left //runtime.tuple//left] [/////synthesis.member/right //runtime.tuple//right]) - (pattern (/////synthesis.!bind_top register thenP)) + (/////synthesis.!bind_top register thenP) (do ///////phase.monad [then! (again thenP)] (in {.#Some (all _.then (_.define (..register register) ..peek_and_pop_cursor) then!)})) - (pattern (/////synthesis.!multi_pop nextP)) + (/////synthesis.!multi_pop nextP) (.let [[extra_pops nextP'] (////synthesis/case.count_pops nextP)] (do ///////phase.monad [next! (again nextP')] @@ -299,19 +299,19 @@ [/////synthesis.#Text_Fork //primitive.text]) (^.with_template [ ] - [(pattern ( idx)) + [( idx) (///////phase#in ( false idx))]) ([/////synthesis.side/left ..left_choice] [/////synthesis.side/right ..right_choice]) (^.with_template [ ] - [(pattern ( lefts)) + [( lefts) (///////phase#in (push_cursor! ( (_.i32 (.int lefts)) ..peek_cursor)))]) ([/////synthesis.member/left //runtime.tuple//left] [/////synthesis.member/right //runtime.tuple//right]) (^.with_template [ ] - [(pattern ( leftP rightP)) + [( leftP rightP) (do ///////phase.monad [left! (again leftP) right! (again rightP)] 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 98411011a..124c94a02 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 @@ -36,10 +36,10 @@ (def (setup $iteration initial? offset bindings body) (-> Var Bit Register (List Expression) Statement Statement) (case bindings - (pattern (list)) + (list) body - (pattern (list binding)) + (list binding) (let [$binding (//case.register offset)] (all _.then (if initial? 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 8b5ee06f9..b1fa42f27 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 @@ -26,17 +26,17 @@ Phase (case synthesis (^.with_template [ ] - [(pattern ( value)) + [( value) (///#in ( value))]) ([synthesis.bit /primitive.bit] [synthesis.i64 /primitive.i64] [synthesis.f64 /primitive.f64] [synthesis.text /primitive.text]) - (pattern (synthesis.variant variantS)) + (synthesis.variant variantS) (/structure.variant generate archive variantS) - (pattern (synthesis.tuple members)) + (synthesis.tuple members) (/structure.tuple generate archive members) {synthesis.#Reference reference} @@ -47,31 +47,31 @@ {reference.#Constant constant} (/reference.constant archive constant)) - (pattern (synthesis.branch/case [valueS pathS])) + (synthesis.branch/case [valueS pathS]) (/case.case generate archive [valueS pathS]) - (pattern (synthesis.branch/exec [this that])) + (synthesis.branch/exec [this that]) (/case.exec generate archive [this that]) - (pattern (synthesis.branch/let [inputS register bodyS])) + (synthesis.branch/let [inputS register bodyS]) (/case.let generate archive [inputS register bodyS]) - (pattern (synthesis.branch/if [conditionS thenS elseS])) + (synthesis.branch/if [conditionS thenS elseS]) (/case.if generate archive [conditionS thenS elseS]) - (pattern (synthesis.branch/get [path recordS])) + (synthesis.branch/get [path recordS]) (/case.get generate archive [path recordS]) - (pattern (synthesis.loop/scope scope)) + (synthesis.loop/scope scope) (/loop.scope generate archive scope) - (pattern (synthesis.loop/again updates)) + (synthesis.loop/again updates) (/loop.again generate archive updates) - (pattern (synthesis.function/abstraction abstraction)) + (synthesis.function/abstraction abstraction) (/function.abstraction generate archive abstraction) - (pattern (synthesis.function/apply application)) + (synthesis.function/apply application) (/function.apply generate archive application) {synthesis.#Extension extension} 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 bc03aae26..2903069f8 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 @@ -184,7 +184,7 @@ body! (_.when_continuous (_.goto @end))))) - (pattern (synthesis.side lefts right?)) + (synthesis.side lefts right?) (operation#in (do _.monad [@success _.new_label] @@ -202,16 +202,16 @@ //runtime.push))) (^.with_template [ ] - [(pattern ( lefts)) + [( lefts) (operation#in (all _.composite ..peek ( lefts) //runtime.push)) ... Extra optimization - (pattern (synthesis.path/seq - ( lefts) - (synthesis.!bind_top register thenP))) + (synthesis.path/seq + ( lefts) + (synthesis.!bind_top register thenP)) (do phase.monad [then! (path' stack_depth @else @end phase archive thenP)] (in (all _.composite 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 200b4db2e..13d5eb827 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 @@ -171,7 +171,7 @@ (def .public (apply generate archive [abstractionS inputsS]) (Generator Apply) (case abstractionS - (pattern (synthesis.constant $abstraction)) + (synthesis.constant $abstraction) (do [! phase.monad] [[@definition |abstraction|] (generation.definition archive $abstraction) .let [actual_arity (list.size inputsS)]] 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 f95ac11cc..8758e7b06 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 @@ -29,7 +29,7 @@ (def (invariant? register changeS) (-> Register Synthesis Bit) (case changeS - (pattern (synthesis.variable/local var)) + (synthesis.variable/local var) (n.= register var) _ 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 6971e4cfa..fbfb53b71 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 @@ -39,47 +39,47 @@ Phase (case synthesis (^.with_template [ ] - [(pattern ( value)) + [( value) (//////phase#in ( value))]) ([synthesis.bit /primitive.bit] [synthesis.i64 /primitive.i64] [synthesis.f64 /primitive.f64] [synthesis.text /primitive.text]) - (pattern (synthesis.variant variantS)) + (synthesis.variant variantS) (/structure.variant expression archive variantS) - (pattern (synthesis.tuple members)) + (synthesis.tuple members) (/structure.tuple expression archive members) {synthesis.#Reference value} (//reference.reference /reference.system archive value) - (pattern (synthesis.branch/case case)) + (synthesis.branch/case case) (/case.case ///extension/common.statement expression archive case) - (pattern (synthesis.branch/exec it)) + (synthesis.branch/exec it) (/case.exec expression archive it) - (pattern (synthesis.branch/let let)) + (synthesis.branch/let let) (/case.let expression archive let) - (pattern (synthesis.branch/if if)) + (synthesis.branch/if if) (/case.if expression archive if) - (pattern (synthesis.branch/get get)) + (synthesis.branch/get get) (/case.get expression archive get) - (pattern (synthesis.loop/scope scope)) + (synthesis.loop/scope scope) (/loop.scope ///extension/common.statement expression archive scope) - (pattern (synthesis.loop/again updates)) + (synthesis.loop/again updates) (//////phase.except ..cannot_recur_as_an_expression []) - (pattern (synthesis.function/abstraction abstraction)) + (synthesis.function/abstraction abstraction) (/function.function ///extension/common.statement expression archive abstraction) - (pattern (synthesis.function/apply application)) + (synthesis.function/apply application) (/function.apply expression archive application) {synthesis.#Extension extension} 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 ea8ca09f0..9e0103911 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 @@ -229,24 +229,24 @@ [/////synthesis.#Text_Fork _.string]) (^.with_template [ ] - [(pattern ( idx)) + [( idx) (///////phase#in ( false idx)) - (pattern ( idx nextP)) + ( idx nextP) (///////phase#each (_.then ( true idx)) (again nextP))]) ([/////synthesis.side/left /////synthesis.simple_left_side ..left_choice] [/////synthesis.side/right /////synthesis.simple_right_side ..right_choice]) - (pattern (/////synthesis.member/left 0)) + (/////synthesis.member/left 0) (///////phase#in (|> ..peek (_.item (_.int +1)) ..push!)) (^.with_template [ ] - [(pattern ( lefts)) + [( lefts) (///////phase#in (|> ..peek ( (_.int (.int lefts))) ..push!))]) ([/////synthesis.member/left //runtime.tuple//left] [/////synthesis.member/right //runtime.tuple//right]) - (pattern (/////synthesis.!bind_top register thenP)) + (/////synthesis.!bind_top register thenP) (do ///////phase.monad [then! (again thenP)] (///////phase#in (all _.then @@ -254,7 +254,7 @@ then!))) (^.with_template [ ] - [(pattern ( preP postP)) + [( preP postP) (do ///////phase.monad [pre! (again preP) post! (again postP)] 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 e96ac884a..55c495cee 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 @@ -34,7 +34,7 @@ Phase! (case synthesis (^.with_template [] - [(pattern ( value)) + [( value) (//////phase#each _.return (expression archive synthesis))]) ([////synthesis.bit] [////synthesis.i64] @@ -46,23 +46,23 @@ [////synthesis.function/apply]) (^.with_template [] - [(pattern { value}) + [{ value} (//////phase#each _.return (expression archive synthesis))]) ([////synthesis.#Reference] [////synthesis.#Extension]) - (pattern (////synthesis.branch/case case)) + (////synthesis.branch/case case) (/case.case! statement expression archive case) (^.with_template [ ] - [(pattern ( value)) + [( value) ( statement expression archive value)]) ([////synthesis.branch/let /case.let!] [////synthesis.branch/if /case.if!] [////synthesis.loop/scope /loop.scope!] [////synthesis.loop/again /loop.again!]) - (pattern (////synthesis.function/abstraction abstraction)) + (////synthesis.function/abstraction abstraction) (//////phase#each _.return (/function.function statement expression archive abstraction)) )) @@ -72,7 +72,7 @@ Phase (case synthesis (^.with_template [ ] - [(pattern ( value)) + [( value) (//////phase#in ( value))]) ([////synthesis.bit /primitive.bit] [////synthesis.i64 /primitive.i64] @@ -83,7 +83,7 @@ (//reference.reference /reference.system archive value) (^.with_template [ ] - [(pattern ( value)) + [( value) ( expression archive value)]) ([////synthesis.variant /structure.variant] [////synthesis.tuple /structure.tuple] @@ -93,13 +93,13 @@ [////synthesis.function/apply /function.apply]) (^.with_template [ ] - [(pattern ( value)) + [( value) ( statement expression archive value)]) ([////synthesis.branch/case /case.case] [////synthesis.loop/scope /loop.scope] [////synthesis.function/abstraction /function.function]) - (pattern (////synthesis.loop/again _)) + (////synthesis.loop/again _) (//////phase.except ..cannot_recur_as_an_expression []) {////synthesis.#Extension extension} diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/case.lux index 39ae8fcd4..00094289c 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 @@ -208,33 +208,33 @@ [/////synthesis.#Text_Fork //primitive.text]) (^.with_template [ ] - [(pattern ( idx)) + [( idx) (///////phase#in ( false idx)) - (pattern ( idx nextP)) + ( idx nextP) (|> nextP again (at ///////phase.monad each (_.then ( true idx))))]) ([/////synthesis.side/left /////synthesis.simple_left_side ..left_choice] [/////synthesis.side/right /////synthesis.simple_right_side ..right_choice]) - (pattern (/////synthesis.member/left 0)) + (/////synthesis.member/left 0) (///////phase#in (|> ..peek (_.item (_.int +0)) ..push!)) (^.with_template [ ] - [(pattern ( lefts)) + [( lefts) (///////phase#in (|> ..peek ( (_.int (.int lefts))) ..push!))]) ([/////synthesis.member/left //runtime.tuple//left] [/////synthesis.member/right //runtime.tuple//right]) - (pattern (/////synthesis.!bind_top register thenP)) + (/////synthesis.!bind_top register thenP) (do ///////phase.monad [then! (again thenP)] (///////phase#in (all _.then (_.set! (..register register) ..peek_and_pop) then!))) - ... (pattern (/////synthesis.!multi_pop nextP)) + ... (/////synthesis.!multi_pop nextP) ... (.let [[extra_pops nextP'] (////synthesis/case.count_pops nextP)] ... (do ///////phase.monad ... [next! (again nextP')] @@ -243,7 +243,7 @@ ... next!)))) (^.with_template [ ] - [(pattern ( preP postP)) + [( preP postP) (do ///////phase.monad [pre! (again preP) post! (again postP)] 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 a5435e72d..ef9fdee7e 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 @@ -39,7 +39,7 @@ Phase (case synthesis (^.with_template [ ] - [(pattern ( value)) + [( value) (//////phase#in ( value))]) ([////synthesis.bit /primitive.bit] [////synthesis.i64 /primitive.i64] @@ -47,7 +47,7 @@ [////synthesis.text /primitive.text]) (^.with_template [ ] - [(pattern ( value)) + [( value) ( expression archive value)]) ([////synthesis.variant /structure.variant] [////synthesis.tuple /structure.tuple] @@ -60,13 +60,13 @@ [////synthesis.function/apply /function.apply]) (^.with_template [ ] - [(pattern ( value)) + [( value) ( ///extension/common.statement expression archive value)]) ([////synthesis.branch/case /case.case] [////synthesis.loop/scope /loop.scope] [////synthesis.function/abstraction /function.function]) - (pattern (////synthesis.loop/again updates)) + (////synthesis.loop/again updates) (//////phase.except ..cannot_recur_as_an_expression []) {////synthesis.#Reference value} 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 5062e41ae..02a90bd13 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 @@ -260,33 +260,33 @@ (///////phase#in (_.set (list (..register register)) ..peek)) (^.with_template [ ] - [(pattern ( idx)) + [( idx) (///////phase#in ( false idx)) - (pattern ( idx nextP)) + ( idx nextP) (|> nextP again (///////phase#each (_.then ( true idx))))]) ([/////synthesis.side/left /////synthesis.simple_left_side ..left_choice] [/////synthesis.side/right /////synthesis.simple_right_side ..right_choice]) - (pattern (/////synthesis.member/left 0)) + (/////synthesis.member/left 0) (///////phase#in (|> ..peek (_.item (_.int +0)) ..push!)) (^.with_template [ ] - [(pattern ( lefts)) + [( lefts) (///////phase#in (|> ..peek ( (_.int (.int lefts))) ..push!))]) ([/////synthesis.member/left //runtime.tuple::left] [/////synthesis.member/right //runtime.tuple::right]) - (pattern (/////synthesis.!bind_top register thenP)) + (/////synthesis.!bind_top register thenP) (do ! [then! (again thenP)] (///////phase#in (all _.then (_.set (list (..register register)) ..peek_and_pop) then!))) - (pattern (/////synthesis.!multi_pop nextP)) + (/////synthesis.!multi_pop nextP) (.let [[extra_pops nextP'] (case.count_pops nextP)] (do ! [next! (again nextP')] @@ -294,13 +294,13 @@ (..multi_pop! (n.+ 2 extra_pops)) next!)))) - (pattern (/////synthesis.path/seq preP postP)) + (/////synthesis.path/seq preP postP) (do ! [pre! (again preP) post! (again postP)] (in (_.then pre! post!))) - (pattern (/////synthesis.path/alt preP postP)) + (/////synthesis.path/alt preP postP) (do ! [pre! (again preP) post! (again postP) 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 135f3e4df..6028a0ac3 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 @@ -32,7 +32,7 @@ Phase (case synthesis (^.with_template [ ] - [(pattern ( value)) + [( value) (//////phase#in ( value))]) ([////synthesis.bit /primitive.bit] [////synthesis.i64 /primitive.i64] @@ -43,7 +43,7 @@ (//reference.reference /reference.system archive value) (^.with_template [ ] - [(pattern ( value)) + [( value) ( generate archive value)]) ([////synthesis.variant /structure.variant] [////synthesis.tuple /structure.tuple] 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 51cb787a3..472f361b6 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 @@ -182,7 +182,7 @@ [/////synthesis.#Text_Fork //primitive.text _.=]) (^.with_template [ ] - [(pattern ( idx)) + [( idx) (///////phase#in (all _.then (_.set! $temp (|> idx .int _.int (//runtime.sum::get ..peek (//runtime.flag )))) (_.if (_.= _.null $temp) @@ -191,16 +191,16 @@ ([/////synthesis.side/left false (<|)] [/////synthesis.side/right true ++]) - (pattern (/////synthesis.member/left 0)) + (/////synthesis.member/left 0) (///////phase#in (_.item (_.int +1) ..peek)) (^.with_template [ ] - [(pattern ( lefts)) + [( lefts) (///////phase#in (|> ..peek ( (_.int (.int lefts))) ..push_cursor!))]) ([/////synthesis.member/left //runtime.tuple::left] [/////synthesis.member/right //runtime.tuple::right]) - (pattern (/////synthesis.path/seq leftP rightP)) + (/////synthesis.path/seq leftP rightP) (do ///////phase.monad [leftO (again leftP) rightO (again rightP)] @@ -208,7 +208,7 @@ leftO rightO))) - (pattern (/////synthesis.path/alt leftP rightP)) + (/////synthesis.path/alt leftP rightP) (do [! ///////phase.monad] [leftO (again leftP) rightO (again rightP)] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/procedure/host.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/procedure/host.lux index 0201e556d..b5a3fcb3a 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/procedure/host.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/procedure/host.lux @@ -25,7 +25,7 @@ ... (def (lua//global proc translate inputs) ... (-> Text @.Proc) ... (case inputs -... (pattern (list [_ {.#Text name}])) +... (list [_ {.#Text name}]) ... (do macro.Monad ... [] ... (in name)) @@ -36,7 +36,7 @@ ... (def (lua//call proc translate inputs) ... (-> Text @.Proc) ... (case inputs -... (pattern (list.partial functionS argsS+)) +... (list.partial functionS argsS+) ... (do [@ macro.Monad] ... [functionO (translate functionS) ... argsO+ (monad.each @ translate argsS+)] @@ -56,7 +56,7 @@ ... (def (table//call proc translate inputs) ... (-> Text @.Proc) ... (case inputs -... (pattern (list.partial tableS [_ {.#Text field}] argsS+)) +... (list.partial tableS [_ {.#Text field}] argsS+) ... (do [@ macro.Monad] ... [tableO (translate tableS) ... argsO+ (monad.each @ translate argsS+)] 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 989d07127..ed6f6710e 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 @@ -39,7 +39,7 @@ Phase (case synthesis (^.with_template [ ] - [(pattern ( value)) + [( value) (//////phase#in ( value))]) ([////synthesis.bit /primitive.bit] [////synthesis.i64 /primitive.i64] @@ -47,7 +47,7 @@ [////synthesis.text /primitive.text]) (^.with_template [ ] - [(pattern ( value)) + [( value) ( expression archive value)]) ([////synthesis.variant /structure.variant] [////synthesis.tuple /structure.tuple] @@ -60,13 +60,13 @@ [////synthesis.function/apply /function.apply]) (^.with_template [ ] - [(pattern ( value)) + [( value) ( ///extension/common.statement expression archive value)]) ([////synthesis.branch/case /case.case] [////synthesis.loop/scope /loop.scope] [////synthesis.function/abstraction /function.function]) - (pattern (////synthesis.loop/again _)) + (////synthesis.loop/again _) (//////phase.except ..cannot_recur_as_an_expression []) {////synthesis.#Reference value} diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/case.lux index 68c958870..f76b378c8 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 @@ -301,33 +301,33 @@ [/////synthesis.#Text_Fork (<| //primitive.text)]) (^.with_template [ ] - [(pattern ( idx)) + [( idx) (///////phase#in ( false idx)) - (pattern ( idx nextP)) + ( idx nextP) (|> nextP again (///////phase#each (_.then ( true idx))))]) ([/////synthesis.side/left /////synthesis.simple_left_side ..left_choice] [/////synthesis.side/right /////synthesis.simple_right_side ..right_choice]) - (pattern (/////synthesis.member/left 0)) + (/////synthesis.member/left 0) (///////phase#in (|> ..peek (_.item (_.int +0)) ..push!)) (^.with_template [ ] - [(pattern ( lefts)) + [( lefts) (///////phase#in (|> ..peek ( (_.int (.int lefts))) ..push!))]) ([/////synthesis.member/left //runtime.tuple//left] [/////synthesis.member/right //runtime.tuple//right]) - (pattern (/////synthesis.!bind_top register thenP)) + (/////synthesis.!bind_top register thenP) (do ///////phase.monad [then! (again thenP)] (///////phase#in (all _.then (_.set (list (..register register)) ..peek_and_pop) then!))) - (pattern (/////synthesis.!multi_pop nextP)) + (/////synthesis.!multi_pop nextP) (.let [[extra_pops nextP'] (case.count_pops nextP)] (do ///////phase.monad [next! (again nextP')] @@ -335,7 +335,7 @@ (..multi_pop! (n.+ 2 extra_pops)) next!)))) - (pattern (/////synthesis.path/seq preP postP)) + (/////synthesis.path/seq preP postP) (do ///////phase.monad [pre! (again preP) post! (again postP)] @@ -343,7 +343,7 @@ pre! post!))) - (pattern (/////synthesis.path/alt preP postP)) + (/////synthesis.path/alt preP postP) (do ///////phase.monad [pre! (again preP) post! (again postP) 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 24b418ffa..2dba1f481 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 @@ -32,7 +32,7 @@ Phase (case synthesis (^.with_template [ ] - [(pattern ( value)) + [( value) (//////phase#in ( value))]) ([////synthesis.bit /primitive.bit] [////synthesis.i64 /primitive.i64] @@ -43,7 +43,7 @@ (//reference.reference /reference.system archive value) (^.with_template [ ] - [(pattern ( value)) + [( value) ( generate archive value)]) ([////synthesis.variant /structure.variant] [////synthesis.tuple /structure.tuple] 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 b9546d729..d35d72f9f 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 @@ -176,7 +176,7 @@ [/////synthesis.#Text_Fork //primitive.text _.string=?/2]) (^.with_template [ ] - [(pattern ( idx)) + [( idx) (///////phase#in (_.let (list [@temp (|> idx .int _.int (//runtime.sum//get ..peek (_.bool )))]) (_.if (_.null?/1 @temp) ..fail! @@ -184,23 +184,23 @@ ([/////synthesis.side/left false (<|)] [/////synthesis.side/right true ++]) - (pattern (/////synthesis.member/left 0)) + (/////synthesis.member/left 0) (///////phase#in (..push_cursor! (_.vector_ref/2 ..peek (_.int +0)))) (^.with_template [ ] - [(pattern ( lefts)) + [( lefts) (///////phase#in (|> ..peek ( (_.int (.int lefts))) ..push_cursor!))]) ([/////synthesis.member/left //runtime.tuple//left] [/////synthesis.member/right //runtime.tuple//right]) - (pattern (/////synthesis.path/seq leftP rightP)) + (/////synthesis.path/seq leftP rightP) (do ///////phase.monad [leftO (again leftP) rightO (again rightP)] (in (_.begin (list leftO rightO)))) - (pattern (/////synthesis.path/alt leftP rightP)) + (/////synthesis.path/alt leftP rightP) (do [! ///////phase.monad] [leftO (again leftP) rightO (again rightP)] 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 3aa00a192..b21dbdaae 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 @@ -77,7 +77,7 @@ (/.with_currying? false (/case.synthesize optimization branchesAB+ archive inputA)) - (pattern (///analysis.no_op value)) + (///analysis.no_op value) (optimization' value) {///analysis.#Apply _} 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 b2e0d357d..e755791ab 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 @@ -1,6 +1,6 @@ (.require [library - [lux (.except) + [lux (.except Pattern) [abstract [equivalence (.only Equivalence)] ["[0]" monad (.only do)]] @@ -290,7 +290,7 @@ path (case input - (pattern (/.branch/get [sub_path sub_input])) + (/.branch/get [sub_path sub_input]) (///#in (/.branch/get [(list#composite path sub_path) sub_input])) _ @@ -301,11 +301,11 @@ (do [! ///.monad] [inputS (synthesize^ archive inputA)] (case [headB tailB+] - (pattern (!masking @variable @output)) + (!masking @variable @output) (..synthesize_masking synthesize^ archive inputS @variable @output) - (pattern [[(///pattern.unit) body] - {.#End}]) + [[(///pattern.unit) body] + {.#End}] (case inputA (^.or {///analysis.#Simple _} {///analysis.#Structure _} @@ -319,18 +319,18 @@ {.#End}] (..synthesize_let synthesize^ archive inputS @variable body) - (^.or (pattern [[(///pattern.bit #1) then] - (list [(///pattern.bit #0) else])]) - (pattern [[(///pattern.bit #1) then] - (list [(///pattern.unit) else])]) - - (pattern [[(///pattern.bit #0) else] - (list [(///pattern.bit #1) then])]) - (pattern [[(///pattern.bit #0) else] - (list [(///pattern.unit) then])])) + (^.or [[(///pattern.bit #1) then] + (list [(///pattern.bit #0) else])] + [[(///pattern.bit #1) then] + (list [(///pattern.unit) else])] + + [[(///pattern.bit #0) else] + (list [(///pattern.bit #1) then])] + [[(///pattern.bit #0) else] + (list [(///pattern.unit) then])]) (..synthesize_if synthesize^ archive inputS then else) - (pattern (!get patterns @member)) + (!get patterns @member) (..synthesize_get synthesize^ archive inputS patterns @member) match @@ -339,7 +339,7 @@ (def .public (count_pops path) (-> Path [Nat Path]) (case path - (pattern (/.path/seq {/.#Pop} path')) + (/.path/seq {/.#Pop} path') (let [[pops post_pops] (count_pops path')] [(++ pops) post_pops]) @@ -374,7 +374,7 @@ {/.#Access Access}) path_storage - (pattern (/.path/bind register)) + (/.path/bind register) (revised #bindings (set.has register) path_storage) @@ -394,22 +394,22 @@ (list#each product.right) (list#mix for_path path_storage)) - (^.or (pattern (/.path/seq left right)) - (pattern (/.path/alt left right))) + (^.or (/.path/seq left right) + (/.path/alt left right)) (list#mix for_path path_storage (list left right)) - (pattern (/.path/then bodyS)) + (/.path/then bodyS) (loop (for_synthesis [bodyS bodyS synthesis_storage path_storage]) (case bodyS (^.or {/.#Simple _} - (pattern (/.constant _))) + (/.constant _)) synthesis_storage - (pattern (/.variant [lefts right? valueS])) + (/.variant [lefts right? valueS]) (for_synthesis valueS synthesis_storage) - (pattern (/.tuple members)) + (/.tuple members) (list#mix for_synthesis synthesis_storage members) {/.#Reference {///reference.#Variable {///reference/variable.#Local register}}} @@ -420,21 +420,21 @@ {/.#Reference {///reference.#Variable var}} (revised #dependencies (set.has var) synthesis_storage) - (pattern (/.function/apply [functionS argsS])) + (/.function/apply [functionS argsS]) (list#mix for_synthesis synthesis_storage {.#Item functionS argsS}) - (pattern (/.function/abstraction [environment arity bodyS])) + (/.function/abstraction [environment arity bodyS]) (list#mix for_synthesis synthesis_storage environment) - (pattern (/.branch/case [inputS pathS])) + (/.branch/case [inputS pathS]) (revised #dependencies (set.union (the #dependencies (for_path pathS synthesis_storage))) (for_synthesis inputS synthesis_storage)) - (pattern (/.branch/exec [before after])) + (/.branch/exec [before after]) (list#mix for_synthesis synthesis_storage (list before after)) - (pattern (/.branch/let [inputS register exprS])) + (/.branch/let [inputS register exprS]) (revised #dependencies (set.union (|> synthesis_storage (revised #bindings (set.has register)) @@ -442,13 +442,13 @@ (the #dependencies))) (for_synthesis inputS synthesis_storage)) - (pattern (/.branch/if [testS thenS elseS])) + (/.branch/if [testS thenS elseS]) (list#mix for_synthesis synthesis_storage (list testS thenS elseS)) - (pattern (/.branch/get [access whole])) + (/.branch/get [access whole]) (for_synthesis whole synthesis_storage) - (pattern (/.loop/scope [start initsS+ iterationS])) + (/.loop/scope [start initsS+ iterationS]) (revised #dependencies (set.union (|> synthesis_storage (revised #bindings (set.union (|> initsS+ @@ -459,7 +459,7 @@ (the #dependencies))) (list#mix for_synthesis synthesis_storage initsS+)) - (pattern (/.loop/again replacementsS+)) + (/.loop/again replacementsS+) (list#mix for_synthesis synthesis_storage replacementsS+) {/.#Extension [extension argsS]} 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 f1bf10c2c..a97634d68 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 @@ -60,7 +60,7 @@ argsS (monad.each ! (phase archive) argsA)] (with_expansions [ (these (/.function/apply [funcS argsS]))] (case funcS - (pattern (/.function/abstraction functionS)) + (/.function/abstraction functionS) (if (n.= (the /.#arity functionS) (list.size argsS)) (do ! @@ -70,7 +70,7 @@ (maybe#each (is (-> [Nat (List Synthesis) Synthesis] Synthesis) (function (_ [start inits iteration]) (case iteration - (pattern (/.loop/scope [start' inits' output])) + (/.loop/scope [start' inits' output]) (if (and (n.= start start') (list.empty? inits')) (/.loop/scope [start inits output]) @@ -81,7 +81,7 @@ (maybe.else )))) (in )) - (pattern (/.function/apply [funcS' argsS'])) + (/.function/apply [funcS' argsS']) (in (/.function/apply [funcS' (list#composite argsS' argsS)])) _ @@ -158,7 +158,7 @@ (monad.each phase.monad (grow environment)) (phase#each (|>> /.tuple)))) - (pattern (..self_reference)) + (..self_reference) (phase#in (/.function/apply [expression (list (/.variable/local 1))])) {/.#Reference reference} @@ -240,7 +240,7 @@ [funcS (grow environment funcS) argsS+ (monad.each ! (grow environment) argsS+)] (in (/.function/apply (case funcS - (pattern (/.function/apply [(..self_reference) pre_argsS+])) + (/.function/apply [(..self_reference) pre_argsS+]) [(..self_reference) (list#composite pre_argsS+ argsS+)] @@ -265,7 +265,7 @@ (phase archive bodyA))) abstraction (is (Operation Abstraction) (case bodyS - (pattern (/.function/abstraction [env' down_arity' bodyS'])) + (/.function/abstraction [env' down_arity' bodyS']) (|> bodyS' (grow env') (at ! each (function (_ body) 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 eb5738a11..c967930bf 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 @@ -102,53 +102,53 @@ {/.#Reference reference} (case reference - (pattern {reference.#Variable (variable.self)}) + {reference.#Variable (variable.self)} (if true_loop? {.#None} {.#Some expr}) - (pattern (reference.constant constant)) + (reference.constant constant) {.#Some expr} - (pattern (reference.local register)) + (reference.local register) {.#Some {/.#Reference (reference.local (register_optimization offset register))}} - (pattern (reference.foreign register)) + (reference.foreign register) (if true_loop? (list.item register scope_environment) {.#Some expr})) - (pattern (/.branch/case [input path])) + (/.branch/case [input path]) (do maybe.monad [input' (again false input) path' (path_optimization (again return?) offset path)] (in (|> path' [input'] /.branch/case))) - (pattern (/.branch/exec [this that])) + (/.branch/exec [this that]) (do maybe.monad [this (again false this) that (again return? that)] (in (/.branch/exec [this that]))) - (pattern (/.branch/let [input register body])) + (/.branch/let [input register body]) (do maybe.monad [input' (again false input) body' (again return? body)] (in (/.branch/let [input' (register_optimization offset register) body']))) - (pattern (/.branch/if [input then else])) + (/.branch/if [input then else]) (do maybe.monad [input' (again false input) then' (again return? then) else' (again return? else)] (in (/.branch/if [input' then' else']))) - (pattern (/.branch/get [path record])) + (/.branch/get [path record]) (do maybe.monad [record (again false record)] (in (/.branch/get [path record]))) - (pattern (/.loop/scope scope)) + (/.loop/scope scope) (do [! maybe.monad] [inits' (|> scope (the /.#inits) @@ -158,24 +158,24 @@ /.#inits inits' /.#iteration iteration']))) - (pattern (/.loop/again args)) + (/.loop/again args) (|> args (monad.each maybe.monad (again false)) (maybe#each (|>> /.loop/again))) - (pattern (/.function/abstraction [environment arity body])) + (/.function/abstraction [environment arity body]) (do [! maybe.monad] [environment' (monad.each ! (again false) environment)] (in (/.function/abstraction [environment' arity body]))) - (pattern (/.function/apply [abstraction arguments])) + (/.function/apply [abstraction arguments]) (do [! maybe.monad] [arguments' (monad.each ! (again false) arguments)] (with_expansions [ (these (do ! [abstraction' (again false abstraction)] (in (/.function/apply [abstraction' arguments']))))] (case abstraction - (pattern {/.#Reference {reference.#Variable (variable.self)}}) + {/.#Reference {reference.#Variable (variable.self)}} (if (and return? (n.= arity (list.size arguments))) (in (/.loop/again arguments')) @@ -187,14 +187,14 @@ ))) ... TODO: Stop relying on this custom code. - (pattern {/.#Extension ["lux syntax char case!" (list.partial input else matches)]}) + {/.#Extension ["lux syntax char case!" (list.partial input else matches)]} (if return? (do [! maybe.monad] [input (again false input) matches (monad.each ! (function (_ match) (case match - (pattern {/.#Structure {analysis/complex.#Tuple (list when then)}}) + {/.#Structure {analysis/complex.#Tuple (list when then)}} (do ! [when (again false when) then (again return? then)] diff --git a/stdlib/source/library/lux/tool/compiler/reference/variable.lux b/stdlib/source/library/lux/tool/compiler/reference/variable.lux index 852a1e058..80b01b5b8 100644 --- a/stdlib/source/library/lux/tool/compiler/reference/variable.lux +++ b/stdlib/source/library/lux/tool/compiler/reference/variable.lux @@ -61,7 +61,7 @@ (def .public self? (-> Variable Bit) (|>> (pipe.case - (pattern (..self)) + (..self) true _ -- cgit v1.2.3