From 220c804f9136c73058802575ee49f3f769d5599f Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 17 Mar 2022 04:29:59 -0400 Subject: De-sigil-ification: ! --- stdlib/source/test/lux.lux | 22 ++++----- stdlib/source/test/lux/control/concurrency/stm.lux | 54 +++++++++++----------- stdlib/source/test/lux/control/parser.lux | 2 +- stdlib/source/test/lux/control/parser/analysis.lux | 24 +++++----- stdlib/source/test/lux/control/parser/code.lux | 40 ++++++++-------- stdlib/source/test/lux/control/parser/json.lux | 8 ++-- .../source/test/lux/control/parser/synthesis.lux | 20 ++++---- stdlib/source/test/lux/control/parser/text.lux | 6 +-- stdlib/source/test/lux/control/parser/type.lux | 6 +-- stdlib/source/test/lux/ffi.jvm.lux | 6 +-- stdlib/source/test/lux/macro/code.lux | 2 +- stdlib/source/test/lux/program.lux | 2 +- stdlib/source/test/lux/target/js.lux | 14 +++--- .../tool/compiler/language/lux/phase/analysis.lux | 48 +++++++++---------- .../compiler/language/lux/phase/analysis/case.lux | 12 ++--- .../language/lux/phase/analysis/function.lux | 8 ++-- 16 files changed, 137 insertions(+), 137 deletions(-) (limited to 'stdlib/source/test') diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index 2cccd5878..576f6e9b9 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -434,7 +434,7 @@ (_.cover [/.using] (`` (with_expansions [ ("lux in-module" "library/lux" library/lux.refer) (static.random code.text (random.ascii/lower 1)) - (static.random code.local_symbol (random.ascii/lower 1)) + (static.random code.local (random.ascii/lower 1)) (static.random code.text (random.ascii/lower 2)) ' (template.symbol []) (static.random code.text (random.ascii/lower 3)) @@ -1117,19 +1117,19 @@ )) (for @.old (as_is) - (as_is (syntax: (for_bindings|test [fn/0 .local_symbol - var/0 .local_symbol - let/0 .local_symbol + (as_is (syntax: (for_bindings|test [fn/0 .local + var/0 .local + let/0 .local - fn/1 .local_symbol - var/1 .local_symbol - let/1 .local_symbol + fn/1 .local + var/1 .local + let/1 .local - fn/2 .local_symbol - var/2 .local_symbol - let/2 .local_symbol + fn/2 .local + var/2 .local + let/2 .local - let/3 .local_symbol]) + let/3 .local]) (in (list (code.bit (case (the .#scopes *lux*) (pattern (list& scope/2 _)) (let [locals/2 (the .#locals scope/2) diff --git a/stdlib/source/test/lux/control/concurrency/stm.lux b/stdlib/source/test/lux/control/concurrency/stm.lux index d3298ae86..ca55f2364 100644 --- a/stdlib/source/test/lux/control/concurrency/stm.lux +++ b/stdlib/source/test/lux/control/concurrency/stm.lux @@ -1,29 +1,29 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - ["[0]" monad {"+" Monad do}] - [\\specification - ["$[0]" functor {"+" Injection Comparison}] - ["$[0]" apply] - ["$[0]" monad]]] - [control - ["[0]" io {"+" IO}]] - [data - ["[0]" product] - [collection - ["[0]" list ("[1]#[0]" functor)]]] - [math - ["[0]" random] - [number - ["n" nat]]]]] - [\\library - ["[0]" / - [// - ["[0]" atom {"+" Atom atom}] - ["[0]" async] - ["[0]" frp {"+" Channel}]]]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + ["[0]" monad {"+" Monad do}] + [\\specification + ["$[0]" functor {"+" Injection Comparison}] + ["$[0]" apply] + ["$[0]" monad]]] + [control + ["[0]" io {"+" IO}]] + [data + ["[0]" product] + [collection + ["[0]" list ("[1]#[0]" functor)]]] + [math + ["[0]" random] + [number + ["n" nat]]]]] + [\\library + ["[0]" / + [// + ["[0]" atom {"+" Atom atom}] + ["[0]" async] + ["[0]" frp {"+" Channel}]]]]) (def: injection (Injection /.STM) @@ -81,13 +81,13 @@ output)))) (in (do async.monad [.let [box (/.var dummy) - [follower sink] (io.run! (/.follow! box))] + [follower sink] (io.run! (/.changes box))] _ (/.commit! (/.write expected box)) _ (/.commit! (/.update (n.* 2) box)) _ (async.future (# sink close)) _ (/.commit! (/.update (n.* 3) box)) changes (frp.list follower)] - (_.cover' [/.follow!] + (_.cover' [/.changes] (# (list.equivalence n.equivalence) = (list expected (n.* 2 expected)) changes)))) diff --git a/stdlib/source/test/lux/control/parser.lux b/stdlib/source/test/lux/control/parser.lux index 8941a8137..5733b780c 100644 --- a/stdlib/source/test/lux/control/parser.lux +++ b/stdlib/source/test/lux/control/parser.lux @@ -235,7 +235,7 @@ actual))))) (_.cover [/.separated_by] (|> (list.interposed (code.text separator) (list#each code.nat expected+)) - (/.result (/.separated_by (.this! (code.text separator)) .nat)) + (/.result (/.separated_by (.this (code.text separator)) .nat)) (match actual (# (list.equivalence n.equivalence) = expected+ diff --git a/stdlib/source/test/lux/control/parser/analysis.lux b/stdlib/source/test/lux/control/parser/analysis.lux index 074115336..32d758505 100644 --- a/stdlib/source/test/lux/control/parser/analysis.lux +++ b/stdlib/source/test/lux/control/parser/analysis.lux @@ -83,15 +83,15 @@ (/.result ( expected)) (!expect {try.#Success _}))))] - [/.bit /.bit! random.bit analysis.bit bit#=] - [/.nat /.nat! random.nat analysis.nat n.=] - [/.int /.int! random.int analysis.int i.=] - [/.frac /.frac! random.safe_frac analysis.frac f.=] - [/.rev /.rev! random.rev analysis.rev r.=] - [/.text /.text! (random.unicode 10) analysis.text text#=] - [/.local /.local! random.nat analysis.local n.=] - [/.foreign /.foreign! random.nat analysis.foreign n.=] - [/.constant /.constant! ..constant analysis.constant symbol#=] + [/.bit /.this_bit random.bit analysis.bit bit#=] + [/.nat /.this_nat random.nat analysis.nat n.=] + [/.int /.this_int random.int analysis.int i.=] + [/.frac /.this_frac random.safe_frac analysis.frac f.=] + [/.rev /.this_rev random.rev analysis.rev r.=] + [/.text /.this_text (random.unicode 10) analysis.text text#=] + [/.local /.this_local random.nat analysis.local n.=] + [/.foreign /.this_foreign random.nat analysis.foreign n.=] + [/.constant /.this_constant ..constant analysis.constant symbol#=] )) (do [! random.monad] [expected random.bit] @@ -117,10 +117,10 @@ (!expect {try.#Success #0}))))) (do [! random.monad] [dummy random.bit] - (_.cover [/.end!] - (and (|> (/.result /.end! (list)) + (_.cover [/.end] + (and (|> (/.result /.end (list)) (!expect {try.#Success _})) - (|> (/.result /.end! (list (analysis.bit dummy))) + (|> (/.result /.end (list (analysis.bit dummy))) (!expect {try.#Failure _}))))) (do [! random.monad] [expected random.bit] diff --git a/stdlib/source/test/lux/control/parser/code.lux b/stdlib/source/test/lux/control/parser/code.lux index 62030c6bd..0063541c4 100644 --- a/stdlib/source/test/lux/control/parser/code.lux +++ b/stdlib/source/test/lux/control/parser/code.lux @@ -1,6 +1,6 @@ (.using [library - [lux "*" + [lux {"-" local global} ["_" test {"+" Test}] [abstract [monad {"+" do}]] @@ -36,11 +36,11 @@ _ false)]) -(def: local_symbol +(def: local (Random Text) (random.ascii/lower 1)) -(def: global_symbol +(def: global (Random Symbol) ($_ random.and (random.ascii/lower 1) @@ -51,8 +51,8 @@ (Random Symbol) ($_ random.either (random#each (|>> [""]) - ..local_symbol) - ..global_symbol + ..local) + ..global )) (def: .public test @@ -83,16 +83,16 @@ (!expect {try.#Failure _})))) ))] - [/.any /.this! (# ! each code.bit random.bit) function.identity code.equivalence] - [/.bit /.bit! random.bit code.bit bit.equivalence] - [/.nat /.nat! random.nat code.nat nat.equivalence] - [/.int /.int! random.int code.int int.equivalence] - [/.rev /.rev! random.rev code.rev rev.equivalence] - [/.frac /.frac! random.safe_frac code.frac frac.equivalence] - [/.text /.text! (random.unicode 1) code.text text.equivalence] - [/.local_symbol /.local_symbol! ..local_symbol code.local_symbol text.equivalence] - [/.global_symbol /.global_symbol! ..global_symbol code.symbol symbol.equivalence] - [/.symbol /.symbol! ..any_symbol code.symbol symbol.equivalence] + [/.any /.this (# ! each code.bit random.bit) function.identity code.equivalence] + [/.bit /.this_bit random.bit code.bit bit.equivalence] + [/.nat /.this_nat random.nat code.nat nat.equivalence] + [/.int /.this_int random.int code.int int.equivalence] + [/.rev /.this_rev random.rev code.rev rev.equivalence] + [/.frac /.this_frac random.safe_frac code.frac frac.equivalence] + [/.text /.this_text (random.unicode 1) code.text text.equivalence] + [/.local /.this_local ..local code.local text.equivalence] + [/.global /.this_global ..global code.symbol symbol.equivalence] + [/.symbol /.this_symbol ..any_symbol code.symbol symbol.equivalence] )) (~~ (template [ ] [(do [! random.monad] @@ -113,8 +113,8 @@ (do [! random.monad] [expected_local random.nat expected_global random.int] - (_.cover [/.local] - (|> (/.result (<>.and (/.local (list (code.nat expected_local)) /.nat) + (_.cover [/.locally] + (|> (/.result (<>.and (/.locally (list (code.nat expected_local)) /.nat) /.int) (list (code.int expected_global))) (!expect (^.multi {try.#Success [actual_local actual_global]} @@ -134,10 +134,10 @@ verdict))))) (do [! random.monad] [dummy (# ! each code.bit random.bit)] - (_.cover [/.end!] - (and (|> (/.result /.end! (list)) + (_.cover [/.end] + (and (|> (/.result /.end (list)) (!expect {try.#Success []})) - (|> (/.result /.end! (list dummy)) + (|> (/.result /.end (list dummy)) (!expect {try.#Failure _}))))) (do [! random.monad] [expected (# ! each code.bit random.bit)] diff --git a/stdlib/source/test/lux/control/parser/json.lux b/stdlib/source/test/lux/control/parser/json.lux index ea42e6178..873001415 100644 --- a/stdlib/source/test/lux/control/parser/json.lux +++ b/stdlib/source/test/lux/control/parser/json.lux @@ -76,9 +76,9 @@ (|> (/.result ( expected) { dummy}) (!expect {try.#Failure _}))))))] - [/.boolean /.boolean? /.boolean! random.bit json.#Boolean bit.equivalence] - [/.number /.number? /.number! ..safe_frac json.#Number frac.equivalence] - [/.string /.string? /.string! (random.unicode 1) json.#String text.equivalence] + [/.boolean /.boolean? /.this_boolean random.bit json.#Boolean bit.equivalence] + [/.number /.number? /.this_number ..safe_frac json.#Number frac.equivalence] + [/.string /.string? /.this_string (random.unicode 1) json.#String text.equivalence] )) (do [! random.monad] [expected (random.unicode 1) @@ -91,7 +91,7 @@ [expected (random.unicode 1) dummy (|> (random.unicode 1) (random.only (|>> (# text.equivalence = expected) not)))] (_.cover [/.value_mismatch] - (|> (/.result (/.string! expected) {json.#String dummy}) + (|> (/.result (/.this_string expected) {json.#String dummy}) (!expect (^.multi {try.#Failure error} (exception.match? /.value_mismatch error)))))) (do [! random.monad] diff --git a/stdlib/source/test/lux/control/parser/synthesis.lux b/stdlib/source/test/lux/control/parser/synthesis.lux index 97d6934ed..0341837ee 100644 --- a/stdlib/source/test/lux/control/parser/synthesis.lux +++ b/stdlib/source/test/lux/control/parser/synthesis.lux @@ -80,13 +80,13 @@ (exception.match? /.cannot_parse error)))))) ))] - [/.bit /.bit! random.bit synthesis.bit bit.equivalence] - [/.i64 /.i64! random.i64 synthesis.i64 i64.equivalence] - [/.f64 /.f64! random.safe_frac synthesis.f64 frac.equivalence] - [/.text /.text! (random.unicode 1) synthesis.text text.equivalence] - [/.local /.local! random.nat synthesis.variable/local n.equivalence] - [/.foreign /.foreign! random.nat synthesis.variable/foreign n.equivalence] - [/.constant /.constant! ..random_constant synthesis.constant symbol.equivalence] + [/.bit /.this_bit random.bit synthesis.bit bit.equivalence] + [/.i64 /.this_i64 random.i64 synthesis.i64 i64.equivalence] + [/.f64 /.this_f64 random.safe_frac synthesis.f64 frac.equivalence] + [/.text /.this_text (random.unicode 1) synthesis.text text.equivalence] + [/.local /.this_local random.nat synthesis.variable/local n.equivalence] + [/.foreign /.this_foreign random.nat synthesis.variable/foreign n.equivalence] + [/.constant /.this_constant ..random_constant synthesis.constant symbol.equivalence] )) ))) @@ -183,10 +183,10 @@ (exception.match? /.unconsumed_input error)))))) (do [! random.monad] [dummy (# ! each (|>> synthesis.i64) random.i64)] - (_.cover [/.end! /.expected_empty_input] - (and (|> (/.result /.end! (list)) + (_.cover [/.end /.expected_empty_input] + (and (|> (/.result /.end (list)) (!expect {try.#Success _})) - (|> (/.result /.end! (list dummy)) + (|> (/.result /.end (list dummy)) (!expect (^.multi {try.#Failure error} (exception.match? /.expected_empty_input error))))))) (do [! random.monad] diff --git a/stdlib/source/test/lux/control/parser/text.lux b/stdlib/source/test/lux/control/parser/text.lux index 0c49e8043..6c4b3b2ff 100644 --- a/stdlib/source/test/lux/control/parser/text.lux +++ b/stdlib/source/test/lux/control/parser/text.lux @@ -299,11 +299,11 @@ ($_ _.and (do [! random.monad] [sample (random.unicode 1)] - (_.cover [/.result /.end!] - (and (|> (/.result /.end! + (_.cover [/.result /.end] + (and (|> (/.result /.end "") (!expect {try.#Success _})) - (|> (/.result /.end! + (|> (/.result /.end sample) (!expect {try.#Failure _}))))) (do [! random.monad] diff --git a/stdlib/source/test/lux/control/parser/type.lux b/stdlib/source/test/lux/control/parser/type.lux index 93020e506..b006b0018 100644 --- a/stdlib/source/test/lux/control/parser/type.lux +++ b/stdlib/source/test/lux/control/parser/type.lux @@ -172,14 +172,14 @@ (_.cover [/.wrong_parameter] (|> (/.result (<| (/.with_extension quantification) (/.with_extension argument) - (/.parameter! 1)) + (/.this_parameter 1)) {.#Parameter 0}) (!expect (^.multi {try.#Failure error} (exception.match? /.wrong_parameter error))))) - (_.cover [/.parameter!] + (_.cover [/.this_parameter] (|> (/.result (<| (/.with_extension quantification) (/.with_extension argument) - (/.parameter! 0)) + (/.this_parameter 0)) {.#Parameter 0}) (!expect {try.#Success [quantification##binding argument##binding _]}))) ))) diff --git a/stdlib/source/test/lux/ffi.jvm.lux b/stdlib/source/test/lux/ffi.jvm.lux index cab7732cb..abdc297c7 100644 --- a/stdlib/source/test/lux/ffi.jvm.lux +++ b/stdlib/source/test/lux/ffi.jvm.lux @@ -648,15 +648,15 @@ ([a] invalid [] (a java/lang/String))))))) (_.cover [/.unknown_type_variable] (let [type_variable ((debug.private /.type_variable) (list (jvm.var var/0) (jvm.var var/1)))] - (and (|> (list (code.local_symbol var/0)) + (and (|> (list (code.local var/0)) (.result type_variable) (try#each (|>> (jvm#= (jvm.var var/0)))) (try.else false)) - (|> (list (code.local_symbol var/1)) + (|> (list (code.local var/1)) (.result type_variable) (try#each (|>> (jvm#= (jvm.var var/1)))) (try.else false)) - (|> (list (code.local_symbol var/2)) + (|> (list (code.local var/2)) (.result type_variable) (pipe.case {try.#Failure error} diff --git a/stdlib/source/test/lux/macro/code.lux b/stdlib/source/test/lux/macro/code.lux index 81c17f991..bf6fb83a6 100644 --- a/stdlib/source/test/lux/macro/code.lux +++ b/stdlib/source/test/lux/macro/code.lux @@ -147,7 +147,7 @@ ( expected))) ))] - [/.local_symbol ..random_text .#Symbol] + [/.local ..random_text .#Symbol] ))))) (def: .public test diff --git a/stdlib/source/test/lux/program.lux b/stdlib/source/test/lux/program.lux index d780d38c9..ecfb45ce1 100644 --- a/stdlib/source/test/lux/program.lux +++ b/stdlib/source/test/lux/program.lux @@ -22,7 +22,7 @@ ["[0]" /]]) (syntax: (actual_program [actual_program (<| .form - (<>.after (.text! "lux def program")) + (<>.after (.this_text "lux def program")) .any)]) (in (list actual_program))) diff --git a/stdlib/source/test/lux/target/js.lux b/stdlib/source/test/lux/target/js.lux index 20a49a462..7d6ef0284 100644 --- a/stdlib/source/test/lux/target/js.lux +++ b/stdlib/source/test/lux/target/js.lux @@ -679,14 +679,14 @@ (/.apply/1 $self (/.+ (/.int +1) $arg/0)) $arg/0))) (/.int +0)))) - (_.cover [/.function!] + (_.cover [/.function_definition] (expression (|>> (as Frac) f.nat (n.= iterations)) (/.apply/* (/.closure (list) ($_ /.then - (/.function! $self (list $arg/0) - (/.return (/.? (/.< (/.int (.int iterations)) $arg/0) - (/.apply/1 $self (/.+ (/.int +1) $arg/0)) - $arg/0))) + (/.function_definition $self (list $arg/0) + (/.return (/.? (/.< (/.int (.int iterations)) $arg/0) + (/.apply/1 $self (/.+ (/.int +1) $arg/0)) + $arg/0))) (/.return (/.apply/1 $self (/.int +0))))) (list)))) (_.cover [/.new] @@ -694,8 +694,8 @@ (expression (|>> (as Frac) (f.= number/0)) (/.apply/1 (/.closure (list $arg/0) ($_ /.then - (/.function! $class (list) - (/.set (/.the field $this) $arg/0)) + (/.function_definition $class (list) + (/.set (/.the field $this) $arg/0)) (/.return (/.the field (/.new $class (list)))))) (/.number number/0))))) ..test|apply diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis.lux index 88577b388..d14a481fa 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis.lux @@ -236,7 +236,7 @@ can_analyse_unary! (`` (and (|> (do phase.monad [_ (//module.declare_labels false tags/* false :variant:) - [:it: it] (|> (code.variant (list (code.local_symbol @any) (` []))) + [:it: it] (|> (code.variant (list (code.local @any) (` []))) (/.phase ..expander archive.empty) //type.inferring)] (in (and (type#= :variant: @@ -255,7 +255,7 @@ (~~ (template [ ] [(|> (do phase.monad [_ (//module.declare_labels false tags/* false :variant:) - [:it: it] (|> (code.variant (list (code.local_symbol ) ( ))) + [:it: it] (|> (code.variant (list (code.local ) ( ))) (/.phase ..expander archive.empty) //type.inferring)] (in (and (type#= :variant: @@ -286,7 +286,7 @@ .let [:either: {.#Named [module/0 module/0] (type (Or .Any :record:))}] _ (//module.declare_labels false (list @left @right) false :either:) - [:it: it] (|> (code.variant (list (code.local_symbol @left))) + [:it: it] (|> (code.variant (list (code.local @left))) (/.phase ..expander archive.empty) //type.inferring)] (in (and (type#= :either: @@ -309,7 +309,7 @@ .let [:either: {.#Named [module/0 module/0] (type (Or .Any :record:))}] _ (//module.declare_labels false (list @left @right) false :either:) - [:it: it] (|> (code.variant (list (code.local_symbol @right) + [:it: it] (|> (code.variant (list (code.local @right) (` []) (code.bit bit/0) (code.nat nat/0) @@ -395,13 +395,13 @@ slots/* (list @any @bit @nat @int @rev @frac @text)] (|> (do phase.monad [_ (//module.declare_labels true slots/* false :record:) - [:it: it] (|> (code.tuple (list (code.local_symbol @text) (code.text text/0) - (code.local_symbol @bit) (code.bit bit/0) - (code.local_symbol @rev) (code.rev rev/0) - (code.local_symbol @int) (code.int int/0) - (code.local_symbol @nat) (code.nat nat/0) - (code.local_symbol @frac) (code.frac frac/0) - (code.local_symbol @any) (` []))) + [:it: it] (|> (code.tuple (list (code.local @text) (code.text text/0) + (code.local @bit) (code.bit bit/0) + (code.local @rev) (code.rev rev/0) + (code.local @int) (code.int int/0) + (code.local @nat) (code.nat nat/0) + (code.local @frac) (code.frac frac/0) + (code.local @any) (` []))) (/.phase ..expander archive.empty) //type.inferring)] (in (and (type#= :record: @@ -758,12 +758,12 @@ (`` (and (~~ (template [ ] [(|> (do phase.monad [_ (//module.declare_labels false tags/* false :variant:) - [:it: it] (|> (` ({{(~ (code.local_symbol )) (~ ( ))} + [:it: it] (|> (` ({{(~ (code.local )) (~ ( ))} (~ (code.frac frac/0)) (~ $parameter/0) (~ (code.frac frac/0))} - {(~ (code.local_symbol )) (~ ( ))})) + {(~ (code.local )) (~ ( ))})) (/.phase ..expander archive.empty) //type.inferring)] (in (and (type#= .Frac :it:) @@ -839,13 +839,13 @@ (~ $parameter/0) (~ (code.frac frac/0))} - [(~ (code.local_symbol @any)) [] - (~ (code.local_symbol @bit)) (~ (code.bit bit/0)) - (~ (code.local_symbol @nat)) (~ (code.nat nat/0)) - (~ (code.local_symbol @int)) (~ (code.int int/0)) - (~ (code.local_symbol @rev)) (~ (code.rev rev/0)) - (~ (code.local_symbol @frac)) (~ (code.frac frac/0)) - (~ (code.local_symbol @text)) (~ (code.text text/0))])) + [(~ (code.local @any)) [] + (~ (code.local @bit)) (~ (code.bit bit/0)) + (~ (code.local @nat)) (~ (code.nat nat/0)) + (~ (code.local @int)) (~ (code.int int/0)) + (~ (code.local @rev)) (~ (code.rev rev/0)) + (~ (code.local @frac)) (~ (code.frac frac/0)) + (~ (code.local @text)) (~ (code.text text/0))])) (/.phase ..expander archive.empty) //type.inferring)] (in (and (type#= .Frac :it:) @@ -917,10 +917,10 @@ @left (random.ascii/lower 9) @right (random.ascii/lower 10) - $abstraction/0 (# ! each code.local_symbol (random.ascii/lower 11)) - $parameter/0 (# ! each code.local_symbol (random.ascii/lower 12)) - $abstraction/1 (# ! each code.local_symbol (random.ascii/lower 13)) - $parameter/1 (# ! each code.local_symbol (random.ascii/lower 14))]) + $abstraction/0 (# ! each code.local (random.ascii/lower 11)) + $parameter/0 (# ! each code.local (random.ascii/lower 12)) + $abstraction/1 (# ! each code.local (random.ascii/lower 13)) + $parameter/1 (# ! each code.local (random.ascii/lower 14))]) ($_ _.and (_.cover [/.phase] (and (..can_analyse_unit! lux module/0) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/case.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/case.lux index 7a36cce34..c7272d0cc 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/case.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/case.lux @@ -63,9 +63,9 @@ [input/0 simple/0] $//inference.simple_parameter [input/1 simple/1] $//inference.simple_parameter [input/2 simple/2] $//inference.simple_parameter - $binding/0 (# ! each code.local_symbol (random.ascii/lower 3)) - $binding/1 (# ! each code.local_symbol (random.ascii/lower 4)) - $binding/2 (# ! each code.local_symbol (random.ascii/lower 5))] + $binding/0 (# ! each code.local (random.ascii/lower 3)) + $binding/1 (# ! each code.local (random.ascii/lower 4)) + $binding/2 (# ! each code.local (random.ascii/lower 5))] ($_ _.and (_.cover [/.tuple] (let [tuple? (is (-> Type Type Bit) @@ -508,9 +508,9 @@ [output/0 body/0] $//inference.simple_parameter [output/1 body/1] (random.only (|>> product.left (same? output/0) not) $//inference.simple_parameter) - $binding/0 (# ! each code.local_symbol (random.ascii/lower 3)) - $binding/1 (# ! each code.local_symbol (random.ascii/lower 4)) - $binding/2 (# ! each code.local_symbol (random.ascii/lower 5)) + $binding/0 (# ! each code.local (random.ascii/lower 3)) + $binding/1 (# ! each code.local (random.ascii/lower 4)) + $binding/2 (# ! each code.local (random.ascii/lower 5)) extension/0 (# ! each code.text (random.ascii/lower 6)) bit/0 random.bit nat/0 random.nat] diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/function.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/function.lux index a770e05e3..6cc3bce45 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/function.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/function.lux @@ -76,10 +76,10 @@ [output/1 term/1] (random.only (|>> product.left (same? output/0) not) $//inference.simple_parameter) name/0 ($symbol.random 1 1) - .let [$function/0 (code.local_symbol function/0) - $function/1 (code.local_symbol function/1) - $argument/0 (code.local_symbol argument/0) - $argument/1 (code.local_symbol argument/1)]] + .let [$function/0 (code.local function/0) + $function/1 (code.local function/1) + $argument/0 (code.local argument/0) + $argument/1 (code.local argument/1)]] ($_ _.and (_.cover [/.function] (let [function?' (is (-> Type Code (-> [(List Analysis) Analysis] Bit) Bit) -- cgit v1.2.3