diff options
| author | Eduardo Julian | 2022-04-08 05:42:36 -0400 |
|---|---|---|
| committer | Eduardo Julian | 2022-04-08 05:42:36 -0400 |
| commit | 0d909187d5b9effcd08f533d50af7d29c0d6bfd8 (patch) | |
| tree | c50f12c5e47e3db90c3a701b54ee9953da942210 /stdlib/source/test/lux/tool/compiler/language | |
| parent | e5e4c2aff562e5c01fefb808d1d68a40f29c9cc5 (diff) | |
De-sigil-ification: $
Diffstat (limited to '')
30 files changed, 3307 insertions, 3307 deletions
diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/analysis.lux b/stdlib/source/test/lux/tool/compiler/language/lux/analysis.lux index 02c25c3e6..27302b091 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/analysis.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/analysis.lux @@ -57,47 +57,47 @@ (def: (random_branch random) (All (_ a) (-> (Random a) (Random (/.Branch' a)))) - ($_ random.and - /pattern.random - random - )) + (all random.and + /pattern.random + random + )) (def: (random_match multiplicity random) (All (_ a) (-> Nat (Random a) (Random (/.Match' a)))) - ($_ random.and - (..random_branch random) - (random.list multiplicity (..random_branch random)) - )) + (all random.and + (..random_branch random) + (random.list multiplicity (..random_branch random)) + )) (def: .public (random multiplicity) (-> Nat (Random /.Analysis)) (<| random.rec (function (_ random)) - (let [random|case ($_ random.and - random - (..random_match multiplicity random) - ) - random|function ($_ random.and - (random.list multiplicity random) - random - ) - random|apply ($_ random.and - random + (let [random|case (all random.and random + (..random_match multiplicity random) ) - random|extension ($_ random.and - (random.ascii/lower 1) + random|function (all random.and (random.list multiplicity random) - )]) - ($_ random.or - /simple.random - (/complex.random multiplicity random) - /reference.random - random|case - random|function - random|apply - random|extension - ))) + random + ) + random|apply (all random.and + random + random + ) + random|extension (all random.and + (random.ascii/lower 1) + (random.list multiplicity random) + )]) + (all random.or + /simple.random + (/complex.random multiplicity random) + /reference.random + random|case + random|function + random|apply + random|extension + ))) (def: test|simple Test @@ -108,30 +108,30 @@ rev random.rev frac random.frac text (random.ascii/lower 1)] - (`` ($_ _.and - (_.cover [/.unit] - (case (/.unit) - (pattern (/.unit)) - true - - _ - false)) - (~~ (template [<tag> <expected>] - [(_.cover [<tag>] - (case (<tag> <expected>) - (pattern (<tag> actual)) - (same? <expected> actual) - - _ - false))] - - [/.bit bit] - [/.nat nat] - [/.int int] - [/.rev rev] - [/.frac frac] - [/.text text])) - )))) + (`` (all _.and + (_.cover [/.unit] + (case (/.unit) + (pattern (/.unit)) + true + + _ + false)) + (~~ (template [<tag> <expected>] + [(_.cover [<tag>] + (case (<tag> <expected>) + (pattern (<tag> actual)) + (same? <expected> actual) + + _ + false))] + + [/.bit bit] + [/.nat nat] + [/.int int] + [/.rev rev] + [/.frac frac] + [/.text text])) + )))) (def: test|complex Test @@ -140,28 +140,28 @@ expected_right (..random 2) expected_lefts random.nat expected_right? random.bit] - ($_ _.and - (_.cover [/.variant] - (let [expected (if expected_right? - expected_right - expected_left)] - (case (/.variant [expected_lefts expected_right? expected]) - (pattern (/.variant [actual_lefts actual_right? actual])) - (and (same? expected_lefts actual_lefts) - (same? expected_right? actual_right?) - (same? expected actual)) - - _ - false))) - (_.cover [/.tuple] - (case (/.tuple (list expected_left expected_right)) - (pattern (/.tuple (list actual_left actual_right))) - (and (same? expected_left actual_left) - (same? expected_right actual_right)) - - _ - false)) - ))) + (all _.and + (_.cover [/.variant] + (let [expected (if expected_right? + expected_right + expected_left)] + (case (/.variant [expected_lefts expected_right? expected]) + (pattern (/.variant [actual_lefts actual_right? actual])) + (and (same? expected_lefts actual_lefts) + (same? expected_right? actual_right?) + (same? expected actual)) + + _ + false))) + (_.cover [/.tuple] + (case (/.tuple (list expected_left expected_right)) + (pattern (/.tuple (list actual_left actual_right))) + (and (same? expected_left actual_left) + (same? expected_right actual_right)) + + _ + false)) + ))) (def: test|reference Test @@ -169,22 +169,22 @@ [expected_register random.nat expected_constant (/symbol.random 1 1) expected_variable /variable.random] - (`` ($_ _.and - (~~ (template [<tag> <expected>] - [(_.cover [<tag>] - (case (<tag> <expected>) - (pattern (<tag> actual)) - (same? <expected> actual) - - _ - false))] - - [/.local expected_register] - [/.foreign expected_register] - [/.constant expected_constant] - [/.variable expected_variable] - )) - )))) + (`` (all _.and + (~~ (template [<tag> <expected>] + [(_.cover [<tag>] + (case (<tag> <expected>) + (pattern (<tag> actual)) + (same? <expected> actual) + + _ + false))] + + [/.local expected_register] + [/.foreign expected_register] + [/.constant expected_constant] + [/.variable expected_variable] + )) + )))) (template: (tagged? <tag> <it>) [(case <it> @@ -201,42 +201,42 @@ (..random 2)) expected_parameter/0 (..random 2) expected_parameter/1 (..random 2)] - ($_ _.and - (_.cover [/.reified /.reification] - (case (|> [expected_abstraction (list expected_parameter/0 expected_parameter/1)] - /.reified - /.reification) - (pattern [actual_abstraction (list actual_parameter/0 actual_parameter/1)]) - (and (same? expected_abstraction actual_abstraction) - (same? expected_parameter/0 actual_parameter/0) - (same? expected_parameter/1 actual_parameter/1)) - - _ - false)) - (_.cover [/.no_op] - (case (/.no_op expected_parameter/0) - (pattern (/.no_op actual)) - (same? expected_parameter/0 actual) - - _ - false)) - ))) + (all _.and + (_.cover [/.reified /.reification] + (case (|> [expected_abstraction (list expected_parameter/0 expected_parameter/1)] + /.reified + /.reification) + (pattern [actual_abstraction (list actual_parameter/0 actual_parameter/1)]) + (and (same? expected_abstraction actual_abstraction) + (same? expected_parameter/0 actual_parameter/0) + (same? expected_parameter/1 actual_parameter/1)) + + _ + false)) + (_.cover [/.no_op] + (case (/.no_op expected_parameter/0) + (pattern (/.no_op actual)) + (same? expected_parameter/0 actual) + + _ + false)) + ))) (def: test|case Test (do random.monad [expected_input (..random 2) expected_match (random_match 2 (..random 2))] - ($_ _.and - (_.cover [/.case] - (case (/.case [expected_input expected_match]) - (pattern (/.case [actual_input actual_match])) - (and (same? expected_input actual_input) - (same? expected_match actual_match)) + (all _.and + (_.cover [/.case] + (case (/.case [expected_input expected_match]) + (pattern (/.case [actual_input actual_match])) + (and (same? expected_input actual_input) + (same? expected_match actual_match)) - _ - false)) - ))) + _ + false)) + ))) (with_expansions [<id> (static.random_nat) <exception> (template.symbol ["exception_" <id>])] @@ -257,73 +257,73 @@ (/.state (/.info version/0 host/0 configuration))) state/1 (has .#location location/1 (/.state (/.info version/1 host/1 configuration)))]] - ($_ _.and - (_.cover [/.set_state] - (|> (do phase.monad - [pre (extension.read function.identity) - _ (/.set_state state/1) - post (extension.read function.identity)] - (in (and (same? state/0 pre) - (same? state/1 post)))) - (phase.result [extension.#bundle extension.empty - extension.#state state/0]) - (try.else false))) - (_.cover [/.failure] - (|> (/.failure expected_error) - (phase.result [extension.#bundle extension.empty - extension.#state state/0]) - (pipe.case - {try.#Failure actual_error} - (and (text.contains? expected_error actual_error) - (text.contains? (location.format location/0) actual_error)) - - _ - false))) - (_.cover [/.except] - (|> (/.except <exception> []) - (phase.result [extension.#bundle extension.empty - extension.#state state/0]) - (pipe.case - {try.#Failure actual_error} - (and (text.contains? (exception.error <exception> []) actual_error) - (text.contains? (location.format location/0) actual_error)) - - _ - false))) - (_.cover [/.with_exception] - (|> (/.failure expected_error) - (/.with_exception <exception> []) - (phase.result [extension.#bundle extension.empty - extension.#state state/0]) - (pipe.case - {try.#Failure actual_error} - (and (text.contains? expected_error actual_error) - (text.contains? (exception.error <exception> []) actual_error) - (text.contains? (location.format location/0) actual_error)) - - _ - false))) - (_.cover [/.assertion] - (and (|> (/.assertion <exception> [] false) - (phase.result [extension.#bundle extension.empty - extension.#state state/0]) - (pipe.case - {try.#Failure actual_error} - (and (text.contains? (exception.error <exception> []) actual_error) - (text.contains? (location.format location/0) actual_error)) - - _ - false)) - (|> (/.assertion <exception> [] true) - (phase.result [extension.#bundle extension.empty - extension.#state state/0]) - (pipe.case - {try.#Success _} - true - - _ - false)))) - )))) + (all _.and + (_.cover [/.set_state] + (|> (do phase.monad + [pre (extension.read function.identity) + _ (/.set_state state/1) + post (extension.read function.identity)] + (in (and (same? state/0 pre) + (same? state/1 post)))) + (phase.result [extension.#bundle extension.empty + extension.#state state/0]) + (try.else false))) + (_.cover [/.failure] + (|> (/.failure expected_error) + (phase.result [extension.#bundle extension.empty + extension.#state state/0]) + (pipe.case + {try.#Failure actual_error} + (and (text.contains? expected_error actual_error) + (text.contains? (location.format location/0) actual_error)) + + _ + false))) + (_.cover [/.except] + (|> (/.except <exception> []) + (phase.result [extension.#bundle extension.empty + extension.#state state/0]) + (pipe.case + {try.#Failure actual_error} + (and (text.contains? (exception.error <exception> []) actual_error) + (text.contains? (location.format location/0) actual_error)) + + _ + false))) + (_.cover [/.with_exception] + (|> (/.failure expected_error) + (/.with_exception <exception> []) + (phase.result [extension.#bundle extension.empty + extension.#state state/0]) + (pipe.case + {try.#Failure actual_error} + (and (text.contains? expected_error actual_error) + (text.contains? (exception.error <exception> []) actual_error) + (text.contains? (location.format location/0) actual_error)) + + _ + false))) + (_.cover [/.assertion] + (and (|> (/.assertion <exception> [] false) + (phase.result [extension.#bundle extension.empty + extension.#state state/0]) + (pipe.case + {try.#Failure actual_error} + (and (text.contains? (exception.error <exception> []) actual_error) + (text.contains? (location.format location/0) actual_error)) + + _ + false)) + (|> (/.assertion <exception> [] true) + (phase.result [extension.#bundle extension.empty + extension.#state state/0]) + (pipe.case + {try.#Success _} + true + + _ + false)))) + )))) (def: test|state Test @@ -342,118 +342,118 @@ configuration ($configuration.random 5) .let [state (has .#location location (/.state (/.info version host configuration)))]] - ($_ _.and - (_.cover [/.info] - (let [it (/.info version host configuration)] - (and (text#= (version.format version) - (the .#version it)) - (same? host - (the .#target it)) - (..tagged? .#Build (the .#mode it)) - (same? configuration (the .#configuration it))))) - (_.cover [/.state] - (let [info (/.info version host configuration) - it (/.state info)] - (and (same? info - (the .#info it)) - (same? location.dummy - (the .#location it)) - (..tagged? .#None (the .#current_module it)) - (..tagged? .#None (the .#expected it)) - (list.empty? (the .#modules it)) - (list.empty? (the .#scopes it)) - (list.empty? (the [.#type_context .#var_bindings] it)) - (case (the .#source it) - [location 0 ""] - (same? location.dummy location) + (all _.and + (_.cover [/.info] + (let [it (/.info version host configuration)] + (and (text#= (version.format version) + (the .#version it)) + (same? host + (the .#target it)) + (..tagged? .#Build (the .#mode it)) + (same? configuration (the .#configuration it))))) + (_.cover [/.state] + (let [info (/.info version host configuration) + it (/.state info)] + (and (same? info + (the .#info it)) + (same? location.dummy + (the .#location it)) + (..tagged? .#None (the .#current_module it)) + (..tagged? .#None (the .#expected it)) + (list.empty? (the .#modules it)) + (list.empty? (the .#scopes it)) + (list.empty? (the [.#type_context .#var_bindings] it)) + (case (the .#source it) + [location 0 ""] + (same? location.dummy location) + + _ + false)))) + (_.cover [/.set_current_module] + (|> (do phase.monad + [_ (/.set_current_module expected_module)] + (extension.read (|>> (the .#current_module) (maybe.else "")))) + (phase.result [extension.#bundle extension.empty + extension.#state state]) + (pipe.case + {try.#Success actual} + (same? expected_module actual) + + _ + false))) + (_.cover [/.with_current_module] + (let [current_module (extension.read (|>> (the .#current_module) (maybe.else "")))] + (|> (do phase.monad + [_ (/.set_current_module expected_module) + pre current_module + mid (/.with_current_module dummy_module + current_module) + post current_module] + (in (and (same? expected_module pre) + (same? dummy_module mid) + (same? expected_module post)))) + (phase.result [extension.#bundle extension.empty + extension.#state state]) + (try.else false)))) + (_.cover [/.location /.set_location] + (let [expected (/.location expected_file)] + (|> (do phase.monad + [_ (/.set_location expected)] + (extension.read (the .#location))) + (phase.result [extension.#bundle extension.empty + extension.#state state]) + (pipe.case + {try.#Success actual} + (same? expected actual) + + _ + false)))) + (_.cover [/.with_location] + (let [expected (/.location expected_file) + dummy (/.location expected_code) + location (extension.read (the .#location))] + (|> (do phase.monad + [_ (/.set_location expected) + pre location + mid (/.with_location dummy + location) + post location] + (in (and (same? expected pre) + (same? dummy mid) + (same? expected post)))) + (phase.result [extension.#bundle extension.empty + extension.#state state]) + (try.else false)))) + (_.cover [/.source /.set_source_code] + (let [expected (/.source expected_file expected_code)] + (|> (do phase.monad + [_ (/.set_source_code expected)] + (extension.read (the .#source))) + (phase.result [extension.#bundle extension.empty + extension.#state state]) + (pipe.case + {try.#Success actual} + (same? expected actual) _ false)))) - (_.cover [/.set_current_module] - (|> (do phase.monad - [_ (/.set_current_module expected_module)] - (extension.read (|>> (the .#current_module) (maybe.else "")))) - (phase.result [extension.#bundle extension.empty - extension.#state state]) - (pipe.case - {try.#Success actual} - (same? expected_module actual) - - _ - false))) - (_.cover [/.with_current_module] - (let [current_module (extension.read (|>> (the .#current_module) (maybe.else "")))] - (|> (do phase.monad - [_ (/.set_current_module expected_module) - pre current_module - mid (/.with_current_module dummy_module - current_module) - post current_module] - (in (and (same? expected_module pre) - (same? dummy_module mid) - (same? expected_module post)))) - (phase.result [extension.#bundle extension.empty - extension.#state state]) - (try.else false)))) - (_.cover [/.location /.set_location] - (let [expected (/.location expected_file)] - (|> (do phase.monad - [_ (/.set_location expected)] - (extension.read (the .#location))) - (phase.result [extension.#bundle extension.empty - extension.#state state]) - (pipe.case - {try.#Success actual} - (same? expected actual) - - _ - false)))) - (_.cover [/.with_location] - (let [expected (/.location expected_file) - dummy (/.location expected_code) - location (extension.read (the .#location))] - (|> (do phase.monad - [_ (/.set_location expected) - pre location - mid (/.with_location dummy - location) - post location] - (in (and (same? expected pre) - (same? dummy mid) - (same? expected post)))) - (phase.result [extension.#bundle extension.empty - extension.#state state]) - (try.else false)))) - (_.cover [/.source /.set_source_code] - (let [expected (/.source expected_file expected_code)] - (|> (do phase.monad - [_ (/.set_source_code expected)] - (extension.read (the .#source))) - (phase.result [extension.#bundle extension.empty - extension.#state state]) - (pipe.case - {try.#Success actual} - (same? expected actual) - - _ - false)))) - (_.cover [/.with_source_code] - (let [expected (/.source expected_file expected_code) - dummy (/.source expected_code expected_file) - source (extension.read (the .#source))] - (|> (do phase.monad - [_ (/.set_source_code expected) - pre source - mid (/.with_source_code dummy - source) - post source] - (in (and (same? expected pre) - (same? dummy mid) - (same? expected post)))) - (phase.result [extension.#bundle extension.empty - extension.#state state]) - (try.else false)))) - ))) + (_.cover [/.with_source_code] + (let [expected (/.source expected_file expected_code) + dummy (/.source expected_code expected_file) + source (extension.read (the .#source))] + (|> (do phase.monad + [_ (/.set_source_code expected) + pre source + mid (/.with_source_code dummy + source) + post source] + (in (and (same? expected pre) + (same? dummy mid) + (same? expected post)))) + (phase.result [extension.#bundle extension.empty + extension.#state state]) + (try.else false)))) + ))) (def: .public test Test @@ -462,32 +462,32 @@ (do random.monad [left (..random 2) right (..random 2)] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence (..random 2))) - - ..test|simple - ..test|complex - ..test|reference - (_.for [/.Reification] - ..test|reification) - (_.for [/.Branch /.Branch' /.Match /.Match'] - ..test|case) - (_.for [/.Operation /.Phase /.Handler /.Bundle] - ..test|phase) - (_.for [/.State+] - ..test|state) - (_.cover [/.format] - (bit#= (# /.equivalence = left right) - (text#= (/.format left) (/.format right)))) - - /complex.test - /inference.test - /macro.test - /module.test - /pattern.test - /scope.test - /simple.test - /type.test - /coverage.test - )))) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence (..random 2))) + + ..test|simple + ..test|complex + ..test|reference + (_.for [/.Reification] + ..test|reification) + (_.for [/.Branch /.Branch' /.Match /.Match'] + ..test|case) + (_.for [/.Operation /.Phase /.Handler /.Bundle] + ..test|phase) + (_.for [/.State+] + ..test|state) + (_.cover [/.format] + (bit#= (# /.equivalence = left right) + (text#= (/.format left) (/.format right)))) + + /complex.test + /inference.test + /macro.test + /module.test + /pattern.test + /scope.test + /simple.test + /type.test + /coverage.test + )))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/complex.lux b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/complex.lux index c6454b07f..5d331f85e 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/complex.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/complex.lux @@ -25,52 +25,52 @@ tag (# ! each (n.% multiplicity) random.nat) lefts random.nat right? random.bit] - ($_ _.and - (_.cover [/.tag /.lefts] - (and (|> lefts - (/.tag right?) - (/.lefts right?) - (n.= lefts)) - (|> tag - (/.lefts right?) - (/.tag right?) - (n.= tag)))) - (_.cover [/.choice] - (let [[lefts right?] (/.choice multiplicity tag)] - (if right? - (n.= (-- tag) lefts) - (n.= tag lefts)))) - ))) + (all _.and + (_.cover [/.tag /.lefts] + (and (|> lefts + (/.tag right?) + (/.lefts right?) + (n.= lefts)) + (|> tag + (/.lefts right?) + (/.tag right?) + (n.= tag)))) + (_.cover [/.choice] + (let [[lefts right?] (/.choice multiplicity tag)] + (if right? + (n.= (-- tag) lefts) + (n.= tag lefts)))) + ))) (def: .public (random multiplicity it) (All (_ a) (-> Nat (Random a) (Random (/.Complex a)))) - ($_ random.or - ($_ random.and - (random#each (n.% (-- multiplicity)) random.nat) - random.bit - it) - (random.list multiplicity it) - )) + (all random.or + (all random.and + (random#each (n.% (-- multiplicity)) random.nat) + random.bit + it) + (random.list multiplicity it) + )) (def: .public test Test (let [random (..random 3 random.nat)] (<| (_.covering /._) (_.for [/.Complex /.Variant /.Tuple]) - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec (/.equivalence n.equivalence) random)) - (_.for [/.hash] - ($hash.spec (/.hash n.hash) random)) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec (/.equivalence n.equivalence) random)) + (_.for [/.hash] + ($hash.spec (/.hash n.hash) random)) - (_.for [/.Tag] - ..test|tag) - - (do random.monad - [left random - right random] - (_.cover [/.format] - (bit#= (# (/.equivalence n.equivalence) = left right) - (text#= (/.format %.nat left) (/.format %.nat right))))) - )))) + (_.for [/.Tag] + ..test|tag) + + (do random.monad + [left random + right random] + (_.cover [/.format] + (bit#= (# (/.equivalence n.equivalence) = left right) + (text#= (/.format %.nat left) (/.format %.nat right))))) + )))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/coverage.lux b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/coverage.lux index 629ffb39f..3bfe7d2fb 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/coverage.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/coverage.lux @@ -46,27 +46,27 @@ (Random /.Coverage) (<| random.rec (function (_ again)) - ($_ random.or - (random#in []) - random.bit - (random.set n.hash ..spread random.nat) - (random.set i.hash ..spread random.int) - (random.set r.hash ..spread random.rev) - (random.set f.hash ..spread random.frac) - (random.set text.hash ..spread (random.unicode 1)) - ($_ random.and - (random.maybe (random#in ..spread)) - (do [! random.monad] - [cases ..random_tag - cases (random.set n.hash cases ..random_tag)] - (|> cases - set.list - (monad.each ! (function (_ case) (# ! each (|>> [case]) again))) - (# ! each (dictionary.of_list n.hash)))) - ) - (random.and again again) - (random.and again again) - ))) + (all random.or + (random#in []) + random.bit + (random.set n.hash ..spread random.nat) + (random.set i.hash ..spread random.int) + (random.set r.hash ..spread random.rev) + (random.set f.hash ..spread random.frac) + (random.set text.hash ..spread (random.unicode 1)) + (all random.and + (random.maybe (random#in ..spread)) + (do [! random.monad] + [cases ..random_tag + cases (random.set n.hash cases ..random_tag)] + (|> cases + set.list + (monad.each ! (function (_ case) (# ! each (|>> [case]) again))) + (# ! each (dictionary.of_list n.hash)))) + ) + (random.and again again) + (random.and again again) + ))) (def: (ranged min range) (-> Nat Nat (Random Nat)) @@ -77,63 +77,63 @@ (Random [/.Coverage Pattern]) (<| random.rec (function (_ again)) - (`` ($_ random.either - (random#in [{/.#Exhaustive} - {//pattern.#Simple {//simple.#Unit}}]) - (do random.monad - [it random.bit] - (in [{/.#Bit it} - {//pattern.#Simple {//simple.#Bit it}}])) - (~~ (template [<random> <hash> <coverage> <pattern>] - [(do random.monad - [it <random>] - (in [{<coverage> (set.of_list <hash> (list it))} - {//pattern.#Simple {<pattern> it}}]))] + (`` (all random.either + (random#in [{/.#Exhaustive} + {//pattern.#Simple {//simple.#Unit}}]) + (do random.monad + [it random.bit] + (in [{/.#Bit it} + {//pattern.#Simple {//simple.#Bit it}}])) + (~~ (template [<random> <hash> <coverage> <pattern>] + [(do random.monad + [it <random>] + (in [{<coverage> (set.of_list <hash> (list it))} + {//pattern.#Simple {<pattern> it}}]))] - [random.nat n.hash /.#Nat //simple.#Nat] - [random.int i.hash /.#Int //simple.#Int] - [random.rev r.hash /.#Rev //simple.#Rev] - [random.frac f.hash /.#Frac //simple.#Frac] - [(random.unicode 1) text.hash /.#Text //simple.#Text] - )) - - (do [! random.monad] - [tag (# ! each ++ ..random_tag) - right? random.bit - .let [lefts (//complex.lefts right? tag)] - [sub_coverage sub_pattern] again] - (in [{/.#Variant (if right? {.#Some tag} {.#None}) - (dictionary.of_list n.hash (list [tag sub_coverage]))} - {//pattern.#Complex - {//complex.#Variant - [//complex.#lefts lefts - //complex.#right? right? - //complex.#value sub_pattern]}}])) - - (do [! random.monad] - [arity (..ranged 2 (n.- 2 ..spread)) - it (random.list arity again) - .let [coverages (list#each product.left it) - patterns (list#each product.right it)]] - (in [(|> coverages - (list.only (|>> /.exhaustive? not)) - list.reversed - (pipe.case - {.#End} - {/.#Exhaustive} - - {.#Item last prevs} - (list#mix (function (_ left right) - {/.#Seq left right}) - last - prevs))) - {//pattern.#Complex {//complex.#Tuple patterns}}])) - - (do random.monad - [register random.nat] - (in [{/.#Exhaustive} - {//pattern.#Bind register}])) - )))) + [random.nat n.hash /.#Nat //simple.#Nat] + [random.int i.hash /.#Int //simple.#Int] + [random.rev r.hash /.#Rev //simple.#Rev] + [random.frac f.hash /.#Frac //simple.#Frac] + [(random.unicode 1) text.hash /.#Text //simple.#Text] + )) + + (do [! random.monad] + [tag (# ! each ++ ..random_tag) + right? random.bit + .let [lefts (//complex.lefts right? tag)] + [sub_coverage sub_pattern] again] + (in [{/.#Variant (if right? {.#Some tag} {.#None}) + (dictionary.of_list n.hash (list [tag sub_coverage]))} + {//pattern.#Complex + {//complex.#Variant + [//complex.#lefts lefts + //complex.#right? right? + //complex.#value sub_pattern]}}])) + + (do [! random.monad] + [arity (..ranged 2 (n.- 2 ..spread)) + it (random.list arity again) + .let [coverages (list#each product.left it) + patterns (list#each product.right it)]] + (in [(|> coverages + (list.only (|>> /.exhaustive? not)) + list.reversed + (pipe.case + {.#End} + {/.#Exhaustive} + + {.#Item last prevs} + (list#mix (function (_ left right) + {/.#Seq left right}) + last + prevs))) + {//pattern.#Complex {//complex.#Tuple patterns}}])) + + (do random.monad + [register random.nat] + (in [{/.#Exhaustive} + {//pattern.#Bind register}])) + )))) (def: (failure? exception it) (All (_ a) (-> (Exception a) (Try /.Coverage) Bit)) @@ -150,48 +150,48 @@ (do [! random.monad] [left ..random right ..random] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) - (_.cover [/.exhaustive?] - (bit#= (/#= {/.#Exhaustive} left) - (/.exhaustive? left))) - (_.cover [/.format] - (bit#= (/#= left right) - (text#= (/.format left) (/.format right)))) - )))) + (_.cover [/.exhaustive?] + (bit#= (/#= {/.#Exhaustive} left) + (/.exhaustive? left))) + (_.cover [/.format] + (bit#= (/#= left right) + (text#= (/.format left) (/.format right)))) + )))) (def: test|coverage Test (<| (let [(open "/#[0]") /.equivalence]) (do [! random.monad] [[expected pattern] ..random_pattern] - ($_ _.and - (_.cover [/.coverage] - (|> pattern - /.coverage - (try#each (/#= expected)) - (try.else false))) - (_.cover [/.invalid_tuple] - (let [invalid? (..failure? /.invalid_tuple)] - (and (|> (list) - {//complex.#Tuple} - {//pattern.#Complex} - /.coverage - invalid?) - (|> (list pattern) - {//complex.#Tuple} - {//pattern.#Complex} - /.coverage - invalid?) - (|> (list pattern pattern) - {//complex.#Tuple} - {//pattern.#Complex} - /.coverage - invalid? - not)))) - )))) + (all _.and + (_.cover [/.coverage] + (|> pattern + /.coverage + (try#each (/#= expected)) + (try.else false))) + (_.cover [/.invalid_tuple] + (let [invalid? (..failure? /.invalid_tuple)] + (and (|> (list) + {//complex.#Tuple} + {//pattern.#Complex} + /.coverage + invalid?) + (|> (list pattern) + {//complex.#Tuple} + {//pattern.#Complex} + /.coverage + invalid?) + (|> (list pattern pattern) + {//complex.#Tuple} + {//pattern.#Complex} + /.coverage + invalid? + not)))) + )))) (def: random_partial_pattern (Random [/.Coverage Pattern]) @@ -212,14 +212,14 @@ .let [cases (dictionary.of_list n.hash (list [tag/0 expected/0] [tag/1 expected/1])) expected_minimum (++ (n.max tag/0 tag/1))]] - ($_ _.and - (_.cover [/.minimum] - (and (n.= expected_minimum (/.minimum [{.#None} cases])) - (n.= expected_maximum (/.minimum [{.#Some expected_maximum} cases])))) - (_.cover [/.maximum] - (and (n.= n#top (/.maximum [{.#None} cases])) - (n.= expected_maximum (/.maximum [{.#Some expected_maximum} cases])))) - )))) + (all _.and + (_.cover [/.minimum] + (and (n.= expected_minimum (/.minimum [{.#None} cases])) + (n.= expected_maximum (/.minimum [{.#Some expected_maximum} cases])))) + (_.cover [/.maximum] + (and (n.= n#top (/.maximum [{.#None} cases])) + (n.= expected_maximum (/.maximum [{.#Some expected_maximum} cases])))) + )))) (def: random_value_pattern (Random [/.Coverage Pattern]) @@ -239,10 +239,10 @@ [[expected/0 pattern/0] ..random_value_pattern [expected/1 pattern/1] (random.only (|>> product.left (/#= expected/0) not) ..random_value_pattern) - [expected/2 pattern/2] (random.only ($_ predicate.and - (|>> product.left (/#= expected/0) not) - (|>> product.left (/#= expected/1) not) - (|>> product.left (pipe.case {/.#Variant _} false _ true))) + [expected/2 pattern/2] (random.only (all predicate.and + (|>> product.left (/#= expected/0) not) + (|>> product.left (/#= expected/1) not) + (|>> product.left (pipe.case {/.#Variant _} false _ true))) ..random_value_pattern) bit random.bit @@ -256,211 +256,211 @@ .let [random_tag (random#each (n.% arity) random.nat)] tag/0 random_tag tag/1 (random.only (|>> (n.= tag/0) not) random_tag)] - ($_ _.and - (_.cover [/.composite] - (let [composes_simples! - (`` (and (|> (/.composite {/.#Bit bit} {/.#Bit (not bit)}) - (try#each (/#= {/.#Exhaustive})) - (try.else false)) - (|> {/.#Bit bit} - (/.composite {/.#Exhaustive}) - (try#each (/#= {/.#Exhaustive})) - (try.else false)) - (~~ (template [<tag> <hash> <value> <next>] - [(|> (/.composite {<tag> (set.of_list <hash> (list <value>))} - {<tag> (set.of_list <hash> (list (|> <value> <next>)))}) - (try#each (/#= {<tag> (set.of_list <hash> (list <value> (|> <value> <next>)))})) - (try.else false)) - (|> {<tag> (set.of_list <hash> (list <value>))} - (/.composite {/.#Exhaustive}) - (try#each (/#= {/.#Exhaustive})) - (try.else false))] + (all _.and + (_.cover [/.composite] + (let [composes_simples! + (`` (and (|> (/.composite {/.#Bit bit} {/.#Bit (not bit)}) + (try#each (/#= {/.#Exhaustive})) + (try.else false)) + (|> {/.#Bit bit} + (/.composite {/.#Exhaustive}) + (try#each (/#= {/.#Exhaustive})) + (try.else false)) + (~~ (template [<tag> <hash> <value> <next>] + [(|> (/.composite {<tag> (set.of_list <hash> (list <value>))} + {<tag> (set.of_list <hash> (list (|> <value> <next>)))}) + (try#each (/#= {<tag> (set.of_list <hash> (list <value> (|> <value> <next>)))})) + (try.else false)) + (|> {<tag> (set.of_list <hash> (list <value>))} + (/.composite {/.#Exhaustive}) + (try#each (/#= {/.#Exhaustive})) + (try.else false))] - [/.#Nat n.hash nat ++] - [/.#Int i.hash int ++] - [/.#Rev r.hash rev ++] - [/.#Frac f.hash frac (f.+ frac)] - [/.#Text text.hash text (%.format text)] - )))) + [/.#Nat n.hash nat ++] + [/.#Int i.hash int ++] + [/.#Rev r.hash rev ++] + [/.#Frac f.hash frac (f.+ frac)] + [/.#Text text.hash text (%.format text)] + )))) - composes_variants! - (let [composes_different_variants! - (let [composes? (is (-> (Maybe Nat) (Maybe Nat) (Maybe Nat) Bit) - (function (_ left right both) - (|> (/.composite {/.#Variant left (dictionary.of_list n.hash (list [tag/0 expected/0]))} - {/.#Variant right (dictionary.of_list n.hash (list [tag/1 expected/1]))}) - (try#each (/#= {/.#Variant both (dictionary.of_list n.hash (list [tag/0 expected/0] - [tag/1 expected/1]))})) - (try.else false))))] - (and (composes? {.#None} {.#None} {.#None}) - (composes? {.#Some arity} {.#None} {.#Some arity}) - (composes? {.#None} {.#Some arity} {.#Some arity}) - (composes? {.#Some arity} {.#Some arity} {.#Some arity}))) + composes_variants! + (let [composes_different_variants! + (let [composes? (is (-> (Maybe Nat) (Maybe Nat) (Maybe Nat) Bit) + (function (_ left right both) + (|> (/.composite {/.#Variant left (dictionary.of_list n.hash (list [tag/0 expected/0]))} + {/.#Variant right (dictionary.of_list n.hash (list [tag/1 expected/1]))}) + (try#each (/#= {/.#Variant both (dictionary.of_list n.hash (list [tag/0 expected/0] + [tag/1 expected/1]))})) + (try.else false))))] + (and (composes? {.#None} {.#None} {.#None}) + (composes? {.#Some arity} {.#None} {.#Some arity}) + (composes? {.#None} {.#Some arity} {.#Some arity}) + (composes? {.#Some arity} {.#Some arity} {.#Some arity}))) - composes_same_variants! - (let [composes? (is (-> (Maybe Nat) (Maybe Nat) (Maybe Nat) Bit) - (function (_ left right both) - (|> (do try.monad - [variant (/.composite {/.#Variant left (dictionary.of_list n.hash (list [tag/0 expected/0]))} - {/.#Variant right (dictionary.of_list n.hash (list [tag/0 expected/1]))}) - expected (/.composite expected/0 expected/1)] - (in (/#= {/.#Variant both (dictionary.of_list n.hash (list [tag/0 expected]))} - variant))) - (try.else false))))] - (and (composes? {.#None} {.#None} {.#None}) - (composes? {.#Some arity} {.#None} {.#Some arity}) - (composes? {.#None} {.#Some arity} {.#Some arity}) - (composes? {.#Some arity} {.#Some arity} {.#Some arity})))] - (and composes_different_variants! composes_same_variants! - (and (|> {/.#Variant {.#None} (dictionary.of_list n.hash (list [tag/0 expected/0]))} - (/.composite {/.#Exhaustive}) - (try#each (/#= {/.#Exhaustive})) - (try.else false)) - (|> {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected/0]))} - (/.composite {/.#Exhaustive}) - (try#each (/#= {/.#Exhaustive})) - (try.else false))))) + (let [composes? (is (-> (Maybe Nat) (Maybe Nat) (Maybe Nat) Bit) + (function (_ left right both) + (|> (do try.monad + [variant (/.composite {/.#Variant left (dictionary.of_list n.hash (list [tag/0 expected/0]))} + {/.#Variant right (dictionary.of_list n.hash (list [tag/0 expected/1]))}) + expected (/.composite expected/0 expected/1)] + (in (/#= {/.#Variant both (dictionary.of_list n.hash (list [tag/0 expected]))} + variant))) + (try.else false))))] + (and (composes? {.#None} {.#None} {.#None}) + (composes? {.#Some arity} {.#None} {.#Some arity}) + (composes? {.#None} {.#Some arity} {.#Some arity}) + (composes? {.#Some arity} {.#Some arity} {.#Some arity})))] + (and composes_different_variants! + composes_same_variants! + (and (|> {/.#Variant {.#None} (dictionary.of_list n.hash (list [tag/0 expected/0]))} + (/.composite {/.#Exhaustive}) + (try#each (/#= {/.#Exhaustive})) + (try.else false)) + (|> {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected/0]))} + (/.composite {/.#Exhaustive}) + (try#each (/#= {/.#Exhaustive})) + (try.else false))))) - composes_sequences! - (and (|> (/.composite {/.#Seq expected/0 expected/1} - {/.#Seq expected/1 expected/0}) - (try#each (/#= {/.#Alt {/.#Seq expected/0 expected/1} - {/.#Seq expected/1 expected/0}})) - (try.else false)) - (|> (do try.monad - [seq (/.composite {/.#Seq expected/0 expected/0} - {/.#Seq expected/0 expected/1}) - expected (/.composite expected/0 expected/1)] - (in (/#= (if (/.exhaustive? expected) - expected/0 - {/.#Seq expected/0 expected}) - seq))) - (try.else false)) - (|> (do try.monad - [seq (/.composite {/.#Seq expected/0 expected/0} - {/.#Seq expected/1 expected/0}) - expected (/.composite expected/0 expected/1)] - (in (/#= {/.#Seq expected expected/0} - seq))) - (try.else false)) - (|> (/.composite {/.#Seq expected/0 expected/1} - expected/1) - (try#each (/#= {/.#Alt {/.#Seq expected/0 expected/1} - expected/1})) - (try.else false)) - (|> (/.composite expected/1 - {/.#Seq expected/0 expected/1}) - (try#each (/#= {/.#Alt expected/1 - {/.#Seq expected/0 expected/1}})) - (try.else false)) - (|> (/.composite expected/0 - {/.#Seq expected/0 expected/1}) - (try#each (/#= expected/0)) - (try.else false))) - - composes_alts! - (and (|> (do try.monad - [alt (/.composite {/.#Exhaustive} - {/.#Alt expected/0 - expected/1})] - (in (/#= {/.#Exhaustive} - alt))) - (try.else false)) - (|> (do try.monad - [alt (/.composite {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 {/.#Exhaustive}]))} - {/.#Alt {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected/0]))} - {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected/1]))}})] - (in (/#= {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 {/.#Exhaustive}]))} - alt))) - (try.else false)) - (|> (do try.monad - [alt (/.composite {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 {/.#Exhaustive}]))} - {/.#Alt {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected/0]))} - {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/1 expected/1]))}})] - (in (/#= {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 {/.#Exhaustive}] - [tag/1 expected/1]))} - alt))) - (try.else false)) - (|> (do try.monad - [alt (/.composite {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected/2]))} - {/.#Alt {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected/0]))} - {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/1 expected/1]))}}) - expected (/.composite expected/2 expected/0)] - (in (/#= {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected] - [tag/1 expected/1]))} - alt))) - (try.else false)) - (|> (do try.monad - [alt (/.composite {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/1 expected/2]))} - {/.#Alt {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected/0]))} - {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/1 expected/1]))}}) - expected (/.composite expected/2 expected/1)] - (in (/#= {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected/0] - [tag/1 expected]))} - alt))) - (try.else false)) - (|> (do try.monad - [alt (/.composite {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/1 expected/1]))} - {/.#Alt {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected/0]))} - expected/2})] - (in (/#= {/.#Alt expected/2 - {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected/0] - [tag/1 expected/1]))}} - alt))) - (try.else false)))] - (and composes_simples! - composes_variants! composes_sequences! - composes_alts!))) - (_.cover [/.redundancy] - (let [redundant? (..failure? /.redundancy)] - (`` (and (redundant? (/.composite {/.#Exhaustive} {/.#Exhaustive})) - (~~ (template [<it>] - [(redundant? (/.composite <it> <it>)) - (redundant? (/.composite <it> {/.#Exhaustive}))] - - [{/.#Bit bit}] - [{/.#Nat (set.of_list n.hash (list nat))}] - [{/.#Int (set.of_list i.hash (list int))}] - [{/.#Rev (set.of_list r.hash (list rev))}] - [{/.#Frac (set.of_list f.hash (list frac))}] - [{/.#Text (set.of_list text.hash (list text))}] - [{/.#Variant {.#None} (dictionary.of_list n.hash (list [tag/0 expected/0]))}] - [{/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected/0]))}] - [{/.#Seq expected/0 expected/1}])) - (redundant? (/.composite {/.#Seq expected/0 expected/1} expected/0)))))) - (_.cover [/.variant_mismatch] - (let [mismatch? (..failure? /.variant_mismatch)] - (and (not (mismatch? (/.composite {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected/0]))} - {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/1 expected/1]))}))) - - (mismatch? (/.composite {/.#Variant {.#Some (++ arity)} (dictionary.of_list n.hash (list [tag/0 expected/0]))} - {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/1 expected/1]))})) - (mismatch? (/.composite {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected/0]))} - {/.#Variant {.#Some (++ arity)} (dictionary.of_list n.hash (list [tag/1 expected/1]))})) - - (mismatch? (/.composite {/.#Variant {.#Some (-- arity)} (dictionary.of_list n.hash (list [tag/0 expected/0]))} - {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/1 expected/1]))})) - (mismatch? (/.composite {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected/0]))} - {/.#Variant {.#Some (-- arity)} (dictionary.of_list n.hash (list [tag/1 expected/1]))})) - - (not (mismatch? (/.composite {/.#Variant {.#None} (dictionary.of_list n.hash (list [tag/0 expected/0]))} - {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/1 expected/1]))}))) - (mismatch? (/.composite {/.#Variant {.#None} (dictionary.of_list n.hash (list [arity expected/0]))} - {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/1 expected/1]))})) - (not (mismatch? (/.composite {/.#Variant {.#None} (dictionary.of_list n.hash (list [(-- arity) expected/0]))} - {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/1 expected/1]))})))))) - )))) + (and (|> (/.composite {/.#Seq expected/0 expected/1} + {/.#Seq expected/1 expected/0}) + (try#each (/#= {/.#Alt {/.#Seq expected/0 expected/1} + {/.#Seq expected/1 expected/0}})) + (try.else false)) + (|> (do try.monad + [seq (/.composite {/.#Seq expected/0 expected/0} + {/.#Seq expected/0 expected/1}) + expected (/.composite expected/0 expected/1)] + (in (/#= (if (/.exhaustive? expected) + expected/0 + {/.#Seq expected/0 expected}) + seq))) + (try.else false)) + (|> (do try.monad + [seq (/.composite {/.#Seq expected/0 expected/0} + {/.#Seq expected/1 expected/0}) + expected (/.composite expected/0 expected/1)] + (in (/#= {/.#Seq expected expected/0} + seq))) + (try.else false)) + (|> (/.composite {/.#Seq expected/0 expected/1} + expected/1) + (try#each (/#= {/.#Alt {/.#Seq expected/0 expected/1} + expected/1})) + (try.else false)) + (|> (/.composite expected/1 + {/.#Seq expected/0 expected/1}) + (try#each (/#= {/.#Alt expected/1 + {/.#Seq expected/0 expected/1}})) + (try.else false)) + (|> (/.composite expected/0 + {/.#Seq expected/0 expected/1}) + (try#each (/#= expected/0)) + (try.else false))) + + composes_alts! + (and (|> (do try.monad + [alt (/.composite {/.#Exhaustive} + {/.#Alt expected/0 + expected/1})] + (in (/#= {/.#Exhaustive} + alt))) + (try.else false)) + (|> (do try.monad + [alt (/.composite {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 {/.#Exhaustive}]))} + {/.#Alt {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected/0]))} + {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected/1]))}})] + (in (/#= {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 {/.#Exhaustive}]))} + alt))) + (try.else false)) + (|> (do try.monad + [alt (/.composite {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 {/.#Exhaustive}]))} + {/.#Alt {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected/0]))} + {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/1 expected/1]))}})] + (in (/#= {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 {/.#Exhaustive}] + [tag/1 expected/1]))} + alt))) + (try.else false)) + (|> (do try.monad + [alt (/.composite {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected/2]))} + {/.#Alt {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected/0]))} + {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/1 expected/1]))}}) + expected (/.composite expected/2 expected/0)] + (in (/#= {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected] + [tag/1 expected/1]))} + alt))) + (try.else false)) + (|> (do try.monad + [alt (/.composite {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/1 expected/2]))} + {/.#Alt {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected/0]))} + {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/1 expected/1]))}}) + expected (/.composite expected/2 expected/1)] + (in (/#= {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected/0] + [tag/1 expected]))} + alt))) + (try.else false)) + (|> (do try.monad + [alt (/.composite {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/1 expected/1]))} + {/.#Alt {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected/0]))} + expected/2})] + (in (/#= {/.#Alt expected/2 + {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected/0] + [tag/1 expected/1]))}} + alt))) + (try.else false)))] + (and composes_simples! + composes_variants! + composes_sequences! + composes_alts!))) + (_.cover [/.redundancy] + (let [redundant? (..failure? /.redundancy)] + (`` (and (redundant? (/.composite {/.#Exhaustive} {/.#Exhaustive})) + (~~ (template [<it>] + [(redundant? (/.composite <it> <it>)) + (redundant? (/.composite <it> {/.#Exhaustive}))] + + [{/.#Bit bit}] + [{/.#Nat (set.of_list n.hash (list nat))}] + [{/.#Int (set.of_list i.hash (list int))}] + [{/.#Rev (set.of_list r.hash (list rev))}] + [{/.#Frac (set.of_list f.hash (list frac))}] + [{/.#Text (set.of_list text.hash (list text))}] + [{/.#Variant {.#None} (dictionary.of_list n.hash (list [tag/0 expected/0]))}] + [{/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected/0]))}] + [{/.#Seq expected/0 expected/1}])) + (redundant? (/.composite {/.#Seq expected/0 expected/1} expected/0)))))) + (_.cover [/.variant_mismatch] + (let [mismatch? (..failure? /.variant_mismatch)] + (and (not (mismatch? (/.composite {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected/0]))} + {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/1 expected/1]))}))) + + (mismatch? (/.composite {/.#Variant {.#Some (++ arity)} (dictionary.of_list n.hash (list [tag/0 expected/0]))} + {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/1 expected/1]))})) + (mismatch? (/.composite {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected/0]))} + {/.#Variant {.#Some (++ arity)} (dictionary.of_list n.hash (list [tag/1 expected/1]))})) + + (mismatch? (/.composite {/.#Variant {.#Some (-- arity)} (dictionary.of_list n.hash (list [tag/0 expected/0]))} + {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/1 expected/1]))})) + (mismatch? (/.composite {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected/0]))} + {/.#Variant {.#Some (-- arity)} (dictionary.of_list n.hash (list [tag/1 expected/1]))})) + + (not (mismatch? (/.composite {/.#Variant {.#None} (dictionary.of_list n.hash (list [tag/0 expected/0]))} + {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/1 expected/1]))}))) + (mismatch? (/.composite {/.#Variant {.#None} (dictionary.of_list n.hash (list [arity expected/0]))} + {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/1 expected/1]))})) + (not (mismatch? (/.composite {/.#Variant {.#None} (dictionary.of_list n.hash (list [(-- arity) expected/0]))} + {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/1 expected/1]))})))))) + )))) (def: .public test Test (<| (_.covering /._) (_.for [/.Coverage]) - ($_ _.and - ..test|value - ..test|coverage - (_.for [/.Variant] - ..test|variant) - ..test|composite - ))) + (all _.and + ..test|value + ..test|coverage + (_.for [/.Variant] + ..test|variant) + ..test|composite + ))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/inference.lux b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/inference.lux index af26cf21c..2ce0c57ad 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/inference.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/inference.lux @@ -83,18 +83,18 @@ (def: .public simple_parameter (Random [Type Code]) - (`` ($_ random.either - (~~ (template [<type> <random> <code>] - [(random#each (|>> <code> [<type>]) <random>)] + (`` (all random.either + (~~ (template [<type> <random> <code>] + [(random#each (|>> <code> [<type>]) <random>)] - [.Bit random.bit code.bit] - [.Nat random.nat code.nat] - [.Int random.int code.int] - [.Rev random.rev code.rev] - [.Frac random.frac code.frac] - [.Text (random.ascii/lower 1) code.text] - )) - ))) + [.Bit random.bit code.bit] + [.Nat random.nat code.nat] + [.Int random.int code.int] + [.Rev random.rev code.rev] + [.Frac random.frac code.frac] + [.Text (random.ascii/lower 1) code.text] + )) + ))) (def: test|general Test @@ -107,109 +107,109 @@ [type/0 term/0] ..simple_parameter arity (# ! each (n.% 10) random.nat) nats (random.list arity random.nat)] - ($_ _.and - (_.cover [/.general] - (and (|> (/.general archive.empty ..analysis expected (list)) - (//type.expecting expected) - (//module.with 0 (product.left name)) - (/phase#each product.right) - (/phase.result state) - (try#each (|>> product.left (type#= expected))) - (try.else false)) - (|> (/.general archive.empty ..analysis - (type.function (list.repeated arity .Nat) expected) - (list#each code.nat nats)) - (//type.expecting expected) - (//module.with 0 (product.left name)) - (/phase#each product.right) - (/phase.result state) - (try#each (function (_ [actual analysis/*]) - (and (type#= expected actual) - (# (list.equivalence //.equivalence) = - (list#each (|>> //.nat) nats) - analysis/*)))) - (try.else false)) - (|> (/.general archive.empty ..analysis - (type (-> type/0 expected)) - (list term/0)) - (//type.expecting expected) - (//module.with 0 (product.left name)) - (/phase#each product.right) - (/phase.result state) - (try#each (|>> product.left (type#= expected))) - (try.else false)) - (|> (/.general archive.empty ..analysis - (type {.#Named name (-> type/0 expected)}) - (list term/0)) - (//type.expecting expected) - (//module.with 0 (product.left name)) - (/phase#each product.right) - (/phase.result state) - (try#each (|>> product.left (type#= expected))) - (try.else false)) - (|> (/.general archive.empty ..analysis - (type (All (_ a) (-> a a))) - (list term/0)) - (//type.expecting type/0) - (//module.with 0 (product.left name)) - (/phase#each product.right) - (/phase#each (|>> product.left (check.clean (list)) //type.check)) - /phase#conjoint - (/phase.result state) - (try#each (type#= type/0)) - (try.else false)) - (|> (/.general archive.empty ..analysis - (type ((All (_ a) (-> a a)) type/0)) - (list term/0)) - (//type.expecting type/0) - (//module.with 0 (product.left name)) - (/phase#each product.right) - (/phase.result state) - (try#each (|>> product.left (type#= type/0))) - (try.else false)) - (|> (do /phase.monad - [[@var varT] (//type.check check.var) - _ (//type.check (check.check varT (type (-> type/0 expected))))] - (/.general archive.empty ..analysis varT (list term/0))) - (//type.expecting expected) - (//module.with 0 (product.left name)) - (/phase#each product.right) - (/phase#each (|>> product.left (check.clean (list)) //type.check)) - /phase#conjoint - (/phase.result state) - (try#each (type#= expected)) - (try.else false)) - (|> (/.general archive.empty ..analysis - (type (Ex (_ a) (-> a a))) - (list (` ("lux io error" "")))) - //type.inferring - (//module.with 0 (product.left name)) - (/phase#each (|>> product.right product.left (check.clean (list)) //type.check)) - /phase#conjoint - (/phase.result state) - (try#each //type.existential?) - (try.else false)) - )) - (_.cover [/.cannot_infer] - (and (|> (/.general archive.empty ..analysis expected (list term/0)) - (//type.expecting expected) - (/phase.result state) - (..fails? /.cannot_infer)) - (|> (do /phase.monad - [[@var varT] (//type.check check.var)] - (/.general archive.empty ..analysis varT (list term/0))) - (//type.expecting expected) - (/phase.result state) - (..fails? /.cannot_infer)))) - (_.cover [/.cannot_infer_argument] - (|> (/.general archive.empty ..analysis - (type (-> expected expected)) - (list term/0)) - (//type.expecting expected) - (//module.with 0 (product.left name)) - (/phase.result state) - (..fails? /.cannot_infer_argument))) - ))) + (all _.and + (_.cover [/.general] + (and (|> (/.general archive.empty ..analysis expected (list)) + (//type.expecting expected) + (//module.with 0 (product.left name)) + (/phase#each product.right) + (/phase.result state) + (try#each (|>> product.left (type#= expected))) + (try.else false)) + (|> (/.general archive.empty ..analysis + (type.function (list.repeated arity .Nat) expected) + (list#each code.nat nats)) + (//type.expecting expected) + (//module.with 0 (product.left name)) + (/phase#each product.right) + (/phase.result state) + (try#each (function (_ [actual analysis/*]) + (and (type#= expected actual) + (# (list.equivalence //.equivalence) = + (list#each (|>> //.nat) nats) + analysis/*)))) + (try.else false)) + (|> (/.general archive.empty ..analysis + (type (-> type/0 expected)) + (list term/0)) + (//type.expecting expected) + (//module.with 0 (product.left name)) + (/phase#each product.right) + (/phase.result state) + (try#each (|>> product.left (type#= expected))) + (try.else false)) + (|> (/.general archive.empty ..analysis + (type {.#Named name (-> type/0 expected)}) + (list term/0)) + (//type.expecting expected) + (//module.with 0 (product.left name)) + (/phase#each product.right) + (/phase.result state) + (try#each (|>> product.left (type#= expected))) + (try.else false)) + (|> (/.general archive.empty ..analysis + (type (All (_ a) (-> a a))) + (list term/0)) + (//type.expecting type/0) + (//module.with 0 (product.left name)) + (/phase#each product.right) + (/phase#each (|>> product.left (check.clean (list)) //type.check)) + /phase#conjoint + (/phase.result state) + (try#each (type#= type/0)) + (try.else false)) + (|> (/.general archive.empty ..analysis + (type ((All (_ a) (-> a a)) type/0)) + (list term/0)) + (//type.expecting type/0) + (//module.with 0 (product.left name)) + (/phase#each product.right) + (/phase.result state) + (try#each (|>> product.left (type#= type/0))) + (try.else false)) + (|> (do /phase.monad + [[@var varT] (//type.check check.var) + _ (//type.check (check.check varT (type (-> type/0 expected))))] + (/.general archive.empty ..analysis varT (list term/0))) + (//type.expecting expected) + (//module.with 0 (product.left name)) + (/phase#each product.right) + (/phase#each (|>> product.left (check.clean (list)) //type.check)) + /phase#conjoint + (/phase.result state) + (try#each (type#= expected)) + (try.else false)) + (|> (/.general archive.empty ..analysis + (type (Ex (_ a) (-> a a))) + (list (` ("lux io error" "")))) + //type.inferring + (//module.with 0 (product.left name)) + (/phase#each (|>> product.right product.left (check.clean (list)) //type.check)) + /phase#conjoint + (/phase.result state) + (try#each //type.existential?) + (try.else false)) + )) + (_.cover [/.cannot_infer] + (and (|> (/.general archive.empty ..analysis expected (list term/0)) + (//type.expecting expected) + (/phase.result state) + (..fails? /.cannot_infer)) + (|> (do /phase.monad + [[@var varT] (//type.check check.var)] + (/.general archive.empty ..analysis varT (list term/0))) + (//type.expecting expected) + (/phase.result state) + (..fails? /.cannot_infer)))) + (_.cover [/.cannot_infer_argument] + (|> (/.general archive.empty ..analysis + (type (-> expected expected)) + (list term/0)) + (//type.expecting expected) + (//module.with 0 (product.left name)) + (/phase.result state) + (..fails? /.cannot_infer_argument))) + ))) (def: test|variant Test @@ -226,99 +226,99 @@ tag (# ! each (n.% arity) random.nat) .let [[lefts right?] (//complex.choice arity tag)] arbitrary_right? random.bit] - ($_ _.and - (_.cover [/.variant] - (let [variantT (type.variant (list#each product.left types/*,terms/*)) - [tagT tagC] (|> types/*,terms/* - (list.item tag) - (maybe.else [Any (' [])])) - variant?' (is (-> Type (Maybe Type) Nat Bit Code Bit) - (function (_ variant inferred lefts right? term) - (|> (do /phase.monad - [inferT (/.variant lefts right? variant) - [_ [it _]] (|> (/.general archive.empty ..analysis inferT (list term)) - //type.inferring)] - (case inferred - {.#Some inferred} - (//type.check - (do check.monad - [_ (check.check inferred it) - _ (check.check it inferred)] - (in true))) - - {.#None} - (in true))) - (//module.with 0 (product.left name)) - (/phase#each product.right) - (/phase.result state) - (try.else false)))) - variant? (is (-> Type Nat Bit Code Bit) - (function (_ type lefts right? term) - (variant?' type {.#Some type} lefts right? term))) + (all _.and + (_.cover [/.variant] + (let [variantT (type.variant (list#each product.left types/*,terms/*)) + [tagT tagC] (|> types/*,terms/* + (list.item tag) + (maybe.else [Any (' [])])) + variant?' (is (-> Type (Maybe Type) Nat Bit Code Bit) + (function (_ variant inferred lefts right? term) + (|> (do /phase.monad + [inferT (/.variant lefts right? variant) + [_ [it _]] (|> (/.general archive.empty ..analysis inferT (list term)) + //type.inferring)] + (case inferred + {.#Some inferred} + (//type.check + (do check.monad + [_ (check.check inferred it) + _ (check.check it inferred)] + (in true))) + + {.#None} + (in true))) + (//module.with 0 (product.left name)) + (/phase#each product.right) + (/phase.result state) + (try.else false)))) + variant? (is (-> Type Nat Bit Code Bit) + (function (_ type lefts right? term) + (variant?' type {.#Some type} lefts right? term))) - can_match_case! - (variant? variantT lefts right? tagC) + can_match_case! + (variant? variantT lefts right? tagC) - names_do_not_matter! - (variant? {.#Named name variantT} lefts right? tagC) + names_do_not_matter! + (variant? {.#Named name variantT} lefts right? tagC) - cases_independent_of_parameters_conform_to_anything! - (variant? (type (Maybe type/0)) 0 #0 (' [])) + cases_independent_of_parameters_conform_to_anything! + (variant? (type (Maybe type/0)) 0 #0 (' [])) - cases_dependent_on_parameters_are_tettered_to_those_parameters! - (and (variant? (type (Maybe type/0)) 0 #1 term/0) - (not (variant? (type (Maybe type/0)) 0 #1 term/1))) + cases_dependent_on_parameters_are_tettered_to_those_parameters! + (and (variant? (type (Maybe type/0)) 0 #1 term/0) + (not (variant? (type (Maybe type/0)) 0 #1 term/1))) - only_bottom_conforms_to_tags_outside_of_range! - (`` (and (~~ (template [<verdict> <term>] - [(bit#= <verdict> (variant? variantT arity arbitrary_right? <term>))] + only_bottom_conforms_to_tags_outside_of_range! + (`` (and (~~ (template [<verdict> <term>] + [(bit#= <verdict> (variant? variantT arity arbitrary_right? <term>))] - [#0 term/0] - [#1 (` ("lux io error" ""))])))) + [#0 term/0] + [#1 (` ("lux io error" ""))])))) - can_handle_universal_quantification! - (and (variant?' (type (All (_ a) (Maybe a))) - {.#Some Maybe} - 0 #0 (' [])) - (variant?' (type (All (_ a) (Maybe a))) - {.#Some (type (Maybe type/0))} - 0 #1 term/0) - (not (variant?' (type (All (_ a) (Maybe a))) - {.#Some Maybe} - 0 #1 term/0))) + can_handle_universal_quantification! + (and (variant?' (type (All (_ a) (Maybe a))) + {.#Some Maybe} + 0 #0 (' [])) + (variant?' (type (All (_ a) (Maybe a))) + {.#Some (type (Maybe type/0))} + 0 #1 term/0) + (not (variant?' (type (All (_ a) (Maybe a))) + {.#Some Maybe} + 0 #1 term/0))) - existential_types_do_not_affect_independent_cases! - (variant?' (type (Ex (_ a) (Maybe a))) - {.#None} - 0 #0 (' [])) + existential_types_do_not_affect_independent_cases! + (variant?' (type (Ex (_ a) (Maybe a))) + {.#None} + 0 #0 (' [])) - existential_types_affect_dependent_cases! - (`` (and (~~ (template [<verdict> <term>] - [(bit#= <verdict> (variant?' (type (Ex (_ a) (Maybe a))) {.#None} 0 #1 <term>))] + existential_types_affect_dependent_cases! + (`` (and (~~ (template [<verdict> <term>] + [(bit#= <verdict> (variant?' (type (Ex (_ a) (Maybe a))) {.#None} 0 #1 <term>))] - [#0 term/0] - [#1 (` ("lux io error" ""))]))))] - (and can_match_case! - names_do_not_matter! + [#0 term/0] + [#1 (` ("lux io error" ""))]))))] + (and can_match_case! + names_do_not_matter! - cases_independent_of_parameters_conform_to_anything! - cases_dependent_on_parameters_are_tettered_to_those_parameters! + cases_independent_of_parameters_conform_to_anything! + cases_dependent_on_parameters_are_tettered_to_those_parameters! - only_bottom_conforms_to_tags_outside_of_range! + only_bottom_conforms_to_tags_outside_of_range! - can_handle_universal_quantification! + can_handle_universal_quantification! - existential_types_do_not_affect_independent_cases! - existential_types_affect_dependent_cases! - ))) - (_.cover [/.not_a_variant] - (let [[tagT tagC] (|> types/*,terms/* - (list.item tag) - (maybe.else [Any (' [])]))] - (|> (/.variant lefts right? tagT) - (/phase.result state) - (..fails? /.not_a_variant)))) - ))) + existential_types_do_not_affect_independent_cases! + existential_types_affect_dependent_cases! + ))) + (_.cover [/.not_a_variant] + (let [[tagT tagC] (|> types/*,terms/* + (list.item tag) + (maybe.else [Any (' [])]))] + (|> (/.variant lefts right? tagT) + (/phase.result state) + (..fails? /.not_a_variant)))) + ))) (def: test|record Test @@ -354,45 +354,45 @@ (try.else false)))) record (type.tuple (list#each product.left types/*,terms/*)) terms (list#each product.right types/*,terms/*)]] - ($_ _.and - (_.cover [/.record] - (let [can_infer_record! - (record? record {.#None} arity terms) + (all _.and + (_.cover [/.record] + (let [can_infer_record! + (record? record {.#None} arity terms) - names_do_not_matter! - (record? {.#Named name record} {.#None} arity terms) - - can_handle_universal_quantification! - (and (record? (All (_ a) (Tuple type/0 a)) - {.#Some (Tuple type/0 type/1)} - 2 (list term/0 term/1)) - (record? (All (_ a) (Tuple a type/0)) - {.#Some (Tuple type/1 type/0)} - 2 (list term/1 term/0))) - - can_handle_existential_quantification! - (and (not (record? (Ex (_ a) (Tuple type/0 a)) - {.#Some (Tuple type/0 type/1)} - 2 (list term/0 term/1))) - (record? (Ex (_ a) (Tuple type/0 a)) - {.#None} - 2 (list term/0 (` ("lux io error" "")))) - (not (record? (Ex (_ a) (Tuple a type/0)) - {.#Some (Tuple type/1 type/0)} - 2 (list term/1 term/0))) - (record? (Ex (_ a) (Tuple a type/0)) - {.#None} - 2 (list (` ("lux io error" "")) term/0)))] - (and can_infer_record! names_do_not_matter! + (record? {.#Named name record} {.#None} arity terms) + can_handle_universal_quantification! + (and (record? (All (_ a) (Tuple type/0 a)) + {.#Some (Tuple type/0 type/1)} + 2 (list term/0 term/1)) + (record? (All (_ a) (Tuple a type/0)) + {.#Some (Tuple type/1 type/0)} + 2 (list term/1 term/0))) + can_handle_existential_quantification! - ))) - (_.cover [/.not_a_record] - (|> (/.record arity type/0) - (/phase.result state) - (..fails? /.not_a_record))) - ))) + (and (not (record? (Ex (_ a) (Tuple type/0 a)) + {.#Some (Tuple type/0 type/1)} + 2 (list term/0 term/1))) + (record? (Ex (_ a) (Tuple type/0 a)) + {.#None} + 2 (list term/0 (` ("lux io error" "")))) + (not (record? (Ex (_ a) (Tuple a type/0)) + {.#Some (Tuple type/1 type/0)} + 2 (list term/1 term/0))) + (record? (Ex (_ a) (Tuple a type/0)) + {.#None} + 2 (list (` ("lux io error" "")) term/0)))] + (and can_infer_record! + names_do_not_matter! + can_handle_universal_quantification! + can_handle_existential_quantification! + ))) + (_.cover [/.not_a_record] + (|> (/.record arity type/0) + (/phase.result state) + (..fails? /.not_a_record))) + ))) (def: .public test Test @@ -406,18 +406,18 @@ ..simple_parameter) lefts (# ! each (n.% 10) random.nat) right? random.bit] - ($_ _.and - ..test|general - ..test|variant - ..test|record - (_.cover [/.invalid_type_application] - (and (|> (/.general archive.empty ..analysis (type (type/0 type/1)) (list term/0)) - (/phase.result state) - (..fails? /.invalid_type_application)) - (|> (/.variant lefts right? (type (type/0 type/1))) - (/phase.result state) - (..fails? /.invalid_type_application)) - (|> (/.record lefts (type (type/0 type/1))) - (/phase.result state) - (..fails? /.invalid_type_application)))) - )))) + (all _.and + ..test|general + ..test|variant + ..test|record + (_.cover [/.invalid_type_application] + (and (|> (/.general archive.empty ..analysis (type (type/0 type/1)) (list term/0)) + (/phase.result state) + (..fails? /.invalid_type_application)) + (|> (/.variant lefts right? (type (type/0 type/1))) + (/phase.result state) + (..fails? /.invalid_type_application)) + (|> (/.record lefts (type (type/0 type/1))) + (/phase.result state) + (..fails? /.invalid_type_application)))) + )))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/macro.lux b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/macro.lux index a7fe6be62..13699b82f 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/macro.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/macro.lux @@ -77,35 +77,35 @@ {try.#Success [state (|> inputs (list.repeated multiplicity) list#conjoint)]}))]]) - ($_ _.and - (_.cover [/.expansion] - (|> (/.expansion ..expander name multiple (list mono)) - (meta.result lux) - (try#each (# (list.equivalence code.equivalence) = - (list.repeated multiplicity mono))) - (try.else false))) - (_.cover [/.expansion_failed] - (|> (/.expansion ..expander name singular (list)) - (meta.result lux) - (pipe.case - {try.#Failure it} - (and (text.contains? expected_error it) - (text.contains? (the exception.#label /.expansion_failed) it)) + (all _.and + (_.cover [/.expansion] + (|> (/.expansion ..expander name multiple (list mono)) + (meta.result lux) + (try#each (# (list.equivalence code.equivalence) = + (list.repeated multiplicity mono))) + (try.else false))) + (_.cover [/.expansion_failed] + (|> (/.expansion ..expander name singular (list)) + (meta.result lux) + (pipe.case + {try.#Failure it} + (and (text.contains? expected_error it) + (text.contains? (the exception.#label /.expansion_failed) it)) - _ - false))) - (_.cover [/.single_expansion] - (|> (/.single_expansion ..expander name singular poly) - (meta.result lux) - (try#each (code#= (|> poly (list.item choice) maybe.trusted))) - (try.else false))) - (_.cover [/.must_have_single_expansion] - (|> (/.single_expansion ..expander name multiple (list mono)) - (meta.result lux) - (pipe.case - {try.#Failure it} - (text.contains? (the exception.#label /.must_have_single_expansion) it) + _ + false))) + (_.cover [/.single_expansion] + (|> (/.single_expansion ..expander name singular poly) + (meta.result lux) + (try#each (code#= (|> poly (list.item choice) maybe.trusted))) + (try.else false))) + (_.cover [/.must_have_single_expansion] + (|> (/.single_expansion ..expander name multiple (list mono)) + (meta.result lux) + (pipe.case + {try.#Failure it} + (text.contains? (the exception.#label /.must_have_single_expansion) it) - _ - false))) - ))) + _ + false))) + ))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/module.lux b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/module.lux index 538f8375a..ca3c27702 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/module.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/module.lux @@ -67,69 +67,69 @@ hash random.nat expected_import (random.ascii/lower 2) expected_alias (random.ascii/lower 3)] - ($_ _.and - (_.cover [/.empty] - (..new? hash (/.empty hash))) - (_.cover [/.create] - (|> (do /phase.monad - [_ (/.create hash name)] - (/extension.lifted (meta.module name))) - (/phase.result state) - (try#each (..new? hash)) - (try.else false))) - (_.cover [/.exists?] - (|> (do /phase.monad - [pre (/.exists? name) - _ (/.create hash name) - post (/.exists? name)] - (in (and (not pre) post))) - (/phase.result state) - (try.else false))) - (_.cover [/.with] - (|> (do /phase.monad - [[it _] (/.with hash name - (in []))] - (in it)) - (/phase.result state) - (try#each (..new? hash)) - (try.else false))) - (_.cover [/.import] - (`` (and (~~ (template [<expected>] - [(|> (do [! /phase.monad] - [_ (/.create hash expected_import) - [it ?] (/.with hash name - (do ! - [_ (if <expected> - (/.import expected_import) - (in []))] - (/extension.lifted - (meta.imported? expected_import))))] - (in ?)) - (/phase.result state) - (try#each (bit#= <expected>)) - (try.else false))] + (all _.and + (_.cover [/.empty] + (..new? hash (/.empty hash))) + (_.cover [/.create] + (|> (do /phase.monad + [_ (/.create hash name)] + (/extension.lifted (meta.module name))) + (/phase.result state) + (try#each (..new? hash)) + (try.else false))) + (_.cover [/.exists?] + (|> (do /phase.monad + [pre (/.exists? name) + _ (/.create hash name) + post (/.exists? name)] + (in (and (not pre) post))) + (/phase.result state) + (try.else false))) + (_.cover [/.with] + (|> (do /phase.monad + [[it _] (/.with hash name + (in []))] + (in it)) + (/phase.result state) + (try#each (..new? hash)) + (try.else false))) + (_.cover [/.import] + (`` (and (~~ (template [<expected>] + [(|> (do [! /phase.monad] + [_ (/.create hash expected_import) + [it ?] (/.with hash name + (do ! + [_ (if <expected> + (/.import expected_import) + (in []))] + (/extension.lifted + (meta.imported? expected_import))))] + (in ?)) + (/phase.result state) + (try#each (bit#= <expected>)) + (try.else false))] - [false] - [true]))))) - (_.cover [/.alias] - (|> (do [! /phase.monad] - [_ (/.create hash expected_import) - [it _] (/.with hash name - (do ! - [_ (/.import expected_import)] - (/.alias expected_alias expected_import)))] - (in it)) - (/phase.result state) - (try#each (|>> (the .#module_aliases) - (pipe.case - (pattern (list [actual_alias actual_import])) - (and (same? expected_alias actual_alias) - (same? expected_import actual_import)) + [false] + [true]))))) + (_.cover [/.alias] + (|> (do [! /phase.monad] + [_ (/.create hash expected_import) + [it _] (/.with hash name + (do ! + [_ (/.import expected_import)] + (/.alias expected_alias expected_import)))] + (in it)) + (/phase.result state) + (try#each (|>> (the .#module_aliases) + (pipe.case + (pattern (list [actual_alias actual_import])) + (and (same? expected_alias actual_alias) + (same? expected_import actual_import)) - _ - false))) - (try.else false))) - ))) + _ + false))) + (try.else false))) + ))) (def: test|state Test @@ -139,62 +139,62 @@ /extension.#state lux]] name (random.ascii/lower 1) hash random.nat] - (`` ($_ _.and - (~~ (template [<set> <query> <not/0> <not/1>] - [(_.cover [<set> <query>] - (|> (do [! /phase.monad] - [[it ?] (/.with hash name - (do ! - [_ (<set> name) - ? (<query> name) - ~0 (<not/0> name) - ~1 (<not/1> name)] - (in (and ? (not ~0) (not ~1)))))] - (in ?)) - (/phase.result state) - (try.else false)))] + (`` (all _.and + (~~ (template [<set> <query> <not/0> <not/1>] + [(_.cover [<set> <query>] + (|> (do [! /phase.monad] + [[it ?] (/.with hash name + (do ! + [_ (<set> name) + ? (<query> name) + ~0 (<not/0> name) + ~1 (<not/1> name)] + (in (and ? (not ~0) (not ~1)))))] + (in ?)) + (/phase.result state) + (try.else false)))] - [/.set_active /.active? /.compiled? /.cached?] - [/.set_compiled /.compiled? /.cached? /.active?] - [/.set_cached /.cached? /.active? /.compiled?] - )) - (_.cover [/.can_only_change_state_of_active_module] - (and (~~ (template [<pre> <post>] - [(|> (/.with hash name - (do /phase.monad - [_ (<pre> name)] - (<post> name))) - (/phase.result state) - (pipe.case - {try.#Success _} - false - - {try.#Failure error} - (text.contains? (the exception.#label /.can_only_change_state_of_active_module) error)))] + [/.set_active /.active? /.compiled? /.cached?] + [/.set_compiled /.compiled? /.cached? /.active?] + [/.set_cached /.cached? /.active? /.compiled?] + )) + (_.cover [/.can_only_change_state_of_active_module] + (and (~~ (template [<pre> <post>] + [(|> (/.with hash name + (do /phase.monad + [_ (<pre> name)] + (<post> name))) + (/phase.result state) + (pipe.case + {try.#Success _} + false + + {try.#Failure error} + (text.contains? (the exception.#label /.can_only_change_state_of_active_module) error)))] - [/.set_compiled /.set_active] - [/.set_compiled /.set_compiled] - [/.set_compiled /.set_cached] - [/.set_cached /.set_active] - [/.set_cached /.set_compiled] - [/.set_cached /.set_cached] - )))) - (_.cover [/.unknown_module] - (and (~~ (template [<set>] - [(|> (<set> name) - (/phase.result state) - (pipe.case - {try.#Success _} - false - - {try.#Failure error} - (text.contains? (the exception.#label /.unknown_module) error)))] + [/.set_compiled /.set_active] + [/.set_compiled /.set_compiled] + [/.set_compiled /.set_cached] + [/.set_cached /.set_active] + [/.set_cached /.set_compiled] + [/.set_cached /.set_cached] + )))) + (_.cover [/.unknown_module] + (and (~~ (template [<set>] + [(|> (<set> name) + (/phase.result state) + (pipe.case + {try.#Success _} + false + + {try.#Failure error} + (text.contains? (the exception.#label /.unknown_module) error)))] - [/.set_active] - [/.set_compiled] - [/.set_cached] - )))) - )))) + [/.set_active] + [/.set_compiled] + [/.set_cached] + )))) + )))) (def: test|definition Test @@ -218,55 +218,55 @@ index (# ! each (n.% arity) random.nat) .let [definition {.#Definition [public? def_type []]} alias {.#Alias [module_name def_name]}]] - ($_ _.and - (_.cover [/.define] - (`` (and (~~ (template [<global>] - [(|> (/.with hash module_name - (/.define def_name <global>)) - (/phase.result state) - (pipe.case - {try.#Success _} true - {try.#Failure _} false))] + (all _.and + (_.cover [/.define] + (`` (and (~~ (template [<global>] + [(|> (/.with hash module_name + (/.define def_name <global>)) + (/phase.result state) + (pipe.case + {try.#Success _} true + {try.#Failure _} false))] - [definition] - [{.#Type [public? def_type {.#Left [labels|head labels|tail]}]}] - [{.#Type [public? def_type {.#Right [labels|head labels|tail]}]}] - [{.#Tag [public? def_type (partial_list labels|head labels|tail) index]}] - [{.#Slot [public? def_type (partial_list labels|head labels|tail) index]}])) - (|> (/.with hash module_name - (do /phase.monad - [_ (/.define def_name definition)] - (/.define alias_name alias))) - (/phase.result state) - (pipe.case - {try.#Success _} true - {try.#Failure _} false))))) - (_.cover [/.cannot_define_more_than_once] - (`` (and (~~ (template [<global>] - [(|> (/.with hash module_name - (do /phase.monad - [_ (/.define def_name <global>)] - (/.define def_name <global>))) - (/phase.result state) - (pipe.case - {try.#Success _} false - {try.#Failure _} true))] + [definition] + [{.#Type [public? def_type {.#Left [labels|head labels|tail]}]}] + [{.#Type [public? def_type {.#Right [labels|head labels|tail]}]}] + [{.#Tag [public? def_type (partial_list labels|head labels|tail) index]}] + [{.#Slot [public? def_type (partial_list labels|head labels|tail) index]}])) + (|> (/.with hash module_name + (do /phase.monad + [_ (/.define def_name definition)] + (/.define alias_name alias))) + (/phase.result state) + (pipe.case + {try.#Success _} true + {try.#Failure _} false))))) + (_.cover [/.cannot_define_more_than_once] + (`` (and (~~ (template [<global>] + [(|> (/.with hash module_name + (do /phase.monad + [_ (/.define def_name <global>)] + (/.define def_name <global>))) + (/phase.result state) + (pipe.case + {try.#Success _} false + {try.#Failure _} true))] - [{.#Definition [public? def_type []]}] - [{.#Type [public? def_type {.#Left [labels|head labels|tail]}]}] - [{.#Type [public? def_type {.#Right [labels|head labels|tail]}]}] - [{.#Tag [public? def_type (partial_list labels|head labels|tail) index]}] - [{.#Slot [public? def_type (partial_list labels|head labels|tail) index]}])) - (|> (/.with hash module_name - (do /phase.monad - [_ (/.define def_name definition) - _ (/.define alias_name alias)] - (/.define alias_name alias))) - (/phase.result state) - (pipe.case - {try.#Success _} false - {try.#Failure _} true))))) - ))) + [{.#Definition [public? def_type []]}] + [{.#Type [public? def_type {.#Left [labels|head labels|tail]}]}] + [{.#Type [public? def_type {.#Right [labels|head labels|tail]}]}] + [{.#Tag [public? def_type (partial_list labels|head labels|tail) index]}] + [{.#Slot [public? def_type (partial_list labels|head labels|tail) index]}])) + (|> (/.with hash module_name + (do /phase.monad + [_ (/.define def_name definition) + _ (/.define alias_name alias)] + (/.define alias_name alias))) + (/phase.result state) + (pipe.case + {try.#Success _} false + {try.#Failure _} true))))) + ))) (def: test|label Test @@ -287,68 +287,68 @@ (random.only (|>> (text#= labels|head) not)) (random.set text.hash (-- arity)) (# ! each set.list))] - ($_ _.and - (_.cover [/.declare_labels] - (`` (and (~~ (template [<side> <record?> <query> <on_success>] - [(|> (/.with hash module_name - (do [! /phase.monad] - [.let [it {.#Named [module_name def_name] def_type}] - _ (/.define def_name {.#Type [public? it {<side> [labels|head labels|tail]}]}) - _ (/.declare_labels <record?> (partial_list labels|head labels|tail) public? it)] - (monad.each ! (|>> [module_name] <query> /extension.lifted) - (partial_list labels|head labels|tail)))) - (/phase.result state) - (pipe.case - {try.#Success _} <on_success> - {try.#Failure _} (not <on_success>)))] + (all _.and + (_.cover [/.declare_labels] + (`` (and (~~ (template [<side> <record?> <query> <on_success>] + [(|> (/.with hash module_name + (do [! /phase.monad] + [.let [it {.#Named [module_name def_name] def_type}] + _ (/.define def_name {.#Type [public? it {<side> [labels|head labels|tail]}]}) + _ (/.declare_labels <record?> (partial_list labels|head labels|tail) public? it)] + (monad.each ! (|>> [module_name] <query> /extension.lifted) + (partial_list labels|head labels|tail)))) + (/phase.result state) + (pipe.case + {try.#Success _} <on_success> + {try.#Failure _} (not <on_success>)))] - [.#Left false meta.tag true] - [.#Left false meta.slot false] - [.#Right true meta.slot true] - [.#Right true meta.tag false]))))) - (_.cover [/.cannot_declare_labels_for_anonymous_type] - (`` (and (~~ (template [<side> <record?>] - [(|> (/.with hash module_name - (do [! /phase.monad] - [.let [it def_type] - _ (/.define def_name {.#Type [public? it {<side> [labels|head labels|tail]}]})] - (/.declare_labels <record?> (partial_list labels|head labels|tail) public? it))) - (/phase.result state) - (pipe.case - {try.#Success _} - false - - {try.#Failure error} - (text.contains? (the exception.#label /.cannot_declare_labels_for_anonymous_type) error)))] + [.#Left false meta.tag true] + [.#Left false meta.slot false] + [.#Right true meta.slot true] + [.#Right true meta.tag false]))))) + (_.cover [/.cannot_declare_labels_for_anonymous_type] + (`` (and (~~ (template [<side> <record?>] + [(|> (/.with hash module_name + (do [! /phase.monad] + [.let [it def_type] + _ (/.define def_name {.#Type [public? it {<side> [labels|head labels|tail]}]})] + (/.declare_labels <record?> (partial_list labels|head labels|tail) public? it))) + (/phase.result state) + (pipe.case + {try.#Success _} + false + + {try.#Failure error} + (text.contains? (the exception.#label /.cannot_declare_labels_for_anonymous_type) error)))] - [.#Left false] - [.#Right true]))))) - (_.cover [/.cannot_declare_labels_for_foreign_type] - (`` (and (~~ (template [<side> <record?>] - [(|> (/.with hash module_name - (do [! /phase.monad] - [.let [it {.#Named [foreign_module def_name] def_type}] - _ (/.define def_name {.#Type [public? it {<side> [labels|head labels|tail]}]})] - (/.declare_labels <record?> (partial_list labels|head labels|tail) public? it))) - (/phase.result state) - (pipe.case - {try.#Success _} - false - - {try.#Failure error} - (text.contains? (the exception.#label /.cannot_declare_labels_for_foreign_type) error)))] + [.#Left false] + [.#Right true]))))) + (_.cover [/.cannot_declare_labels_for_foreign_type] + (`` (and (~~ (template [<side> <record?>] + [(|> (/.with hash module_name + (do [! /phase.monad] + [.let [it {.#Named [foreign_module def_name] def_type}] + _ (/.define def_name {.#Type [public? it {<side> [labels|head labels|tail]}]})] + (/.declare_labels <record?> (partial_list labels|head labels|tail) public? it))) + (/phase.result state) + (pipe.case + {try.#Success _} + false + + {try.#Failure error} + (text.contains? (the exception.#label /.cannot_declare_labels_for_foreign_type) error)))] - [.#Left false] - [.#Right true]))))) - ))) + [.#Left false] + [.#Right true]))))) + ))) (def: .public test Test (<| (_.covering /._) - ($_ _.and - ..test|module - ..test|state - ..test|definition - (_.for [/.Label] - ..test|label) - ))) + (all _.and + ..test|module + ..test|state + ..test|definition + (_.for [/.Label] + ..test|label) + ))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/pattern.lux b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/pattern.lux index cd72d2b50..9151db036 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/pattern.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/pattern.lux @@ -23,11 +23,11 @@ (Random /.Pattern) (random.rec (function (_ random) - ($_ random.or - //simple.random - (//complex.random 4 random) - random.nat - )))) + (all random.or + //simple.random + (//complex.random 4 random) + random.nat + )))) (def: .public test Test @@ -47,66 +47,66 @@ left ..random right ..random]) - (`` ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) - - (_.cover [/.format] - (bit#= (# /.equivalence = left right) - (text#= (/.format left) (/.format right)))) - (_.cover [/.unit] - (case (/.unit) - (pattern (/.unit)) - true + (`` (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + + (_.cover [/.format] + (bit#= (# /.equivalence = left right) + (text#= (/.format left) (/.format right)))) + (_.cover [/.unit] + (case (/.unit) + (pattern (/.unit)) + true - _ - false)) - (~~ (template [<tag> <value>] - [(_.cover [<tag>] - (case (<tag> <value>) - (pattern (<tag> actual)) - (same? <value> actual) + _ + false)) + (~~ (template [<tag> <value>] + [(_.cover [<tag>] + (case (<tag> <value>) + (pattern (<tag> actual)) + (same? <value> actual) - _ - false))] + _ + false))] - [/.bind expected_register] - [/.bit expected_bit] - [/.nat expected_nat] - [/.int expected_int] - [/.rev expected_rev] - [/.frac expected_frac] - [/.text expected_text] - )) - (_.cover [/.variant] - (case (/.variant [expected_lefts expected_right? (/.text expected_text)]) - (pattern (/.variant [actual_lefts actual_right? (/.text actual_text)])) - (and (same? expected_lefts actual_lefts) - (same? expected_right? actual_right?) - (same? expected_text actual_text)) + [/.bind expected_register] + [/.bit expected_bit] + [/.nat expected_nat] + [/.int expected_int] + [/.rev expected_rev] + [/.frac expected_frac] + [/.text expected_text] + )) + (_.cover [/.variant] + (case (/.variant [expected_lefts expected_right? (/.text expected_text)]) + (pattern (/.variant [actual_lefts actual_right? (/.text actual_text)])) + (and (same? expected_lefts actual_lefts) + (same? expected_right? actual_right?) + (same? expected_text actual_text)) - _ - false)) - (_.cover [/.tuple] - (case (/.tuple (list (/.bit expected_bit) - (/.nat expected_nat) - (/.int expected_int) - (/.rev expected_rev) - (/.frac expected_frac) - (/.text expected_text))) - (pattern (/.tuple (list (/.bit actual_bit) - (/.nat actual_nat) - (/.int actual_int) - (/.rev actual_rev) - (/.frac actual_frac) - (/.text actual_text)))) - (and (same? expected_bit actual_bit) - (same? expected_nat actual_nat) - (same? expected_int actual_int) - (same? expected_rev actual_rev) - (same? expected_frac actual_frac) - (same? expected_text actual_text)) + _ + false)) + (_.cover [/.tuple] + (case (/.tuple (list (/.bit expected_bit) + (/.nat expected_nat) + (/.int expected_int) + (/.rev expected_rev) + (/.frac expected_frac) + (/.text expected_text))) + (pattern (/.tuple (list (/.bit actual_bit) + (/.nat actual_nat) + (/.int actual_int) + (/.rev actual_rev) + (/.frac actual_frac) + (/.text actual_text)))) + (and (same? expected_bit actual_bit) + (same? expected_nat actual_nat) + (same? expected_int actual_int) + (same? expected_rev actual_rev) + (same? expected_frac actual_frac) + (same? expected_text actual_text)) - _ - false)) - )))) + _ + false)) + )))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/scope.lux b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/scope.lux index bd2309561..1d3895914 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/scope.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/scope.lux @@ -58,147 +58,147 @@ name/1 (random.ascii/lower 2) type/0 ($type.random 0) type/1 ($type.random 0)] - ($_ _.and - (_.cover [/.variable] - (|> (/.variable name/0) - /.with - (//phase.result state) - (try#each (|>> product.right - (pipe.case - {.#None} true - {.#Some _} false))) - (try.else false))) - (_.cover [/.with_local] - (|> (/.with_local [name/0 type/0] - (/.variable name/0)) - /.with - (//phase.result state) - (try#each (|>> product.right - (maybe#each (..local? type/0 0)) - (maybe.else false))) - (try.else false))) - (_.cover [/.next] - (|> (<| (do [! //phase.monad] - [register/0 /.next]) - (/.with_local [name/0 type/0]) - (do ! - [var/0 (/.variable name/0)]) - (do ! - [register/1 /.next]) - (/.with_local [name/1 type/1]) - (do ! - [var/1 (/.variable name/1)]) - (in (do maybe.monad - [var/0 var/0 - var/1 var/1] - (in [[register/0 var/0] [register/1 var/1]])))) - /.with - (//phase.result state) - (try#each (|>> product.right - (maybe#each (function (_ [[register/0 var/0] [register/1 var/1]]) - (and (..local? type/0 register/0 var/0) - (..local? type/1 register/1 var/1)))) - (maybe.else false))) - (try.else false))) - (_.cover [/.no_scope] - (and (|> (/.with_local [name/0 type/0] - (//phase#in false)) - (//phase.result state) - (exception.otherwise (exception.match? /.no_scope))) - (|> (do //phase.monad - [_ /.next] - (in false)) - (//phase.result state) - (exception.otherwise (exception.match? /.no_scope))))) - (_.cover [/.reset] - (and (|> /.next + (all _.and + (_.cover [/.variable] + (|> (/.variable name/0) + /.with + (//phase.result state) + (try#each (|>> product.right + (pipe.case + {.#None} true + {.#Some _} false))) + (try.else false))) + (_.cover [/.with_local] + (|> (/.with_local [name/0 type/0] + (/.variable name/0)) + /.with + (//phase.result state) + (try#each (|>> product.right + (maybe#each (..local? type/0 0)) + (maybe.else false))) + (try.else false))) + (_.cover [/.next] + (|> (<| (do [! //phase.monad] + [register/0 /.next]) (/.with_local [name/0 type/0]) - /.with - (//phase.result state) - (try#each (|>> product.right - (n.= 1))) - (try.else false)) - (|> /.next - /.reset + (do ! + [var/0 (/.variable name/0)]) + (do ! + [register/1 /.next]) + (/.with_local [name/1 type/1]) + (do ! + [var/1 (/.variable name/1)]) + (in (do maybe.monad + [var/0 var/0 + var/1 var/1] + (in [[register/0 var/0] [register/1 var/1]])))) + /.with + (//phase.result state) + (try#each (|>> product.right + (maybe#each (function (_ [[register/0 var/0] [register/1 var/1]]) + (and (..local? type/0 register/0 var/0) + (..local? type/1 register/1 var/1)))) + (maybe.else false))) + (try.else false))) + (_.cover [/.no_scope] + (and (|> (/.with_local [name/0 type/0] + (//phase#in false)) + (//phase.result state) + (exception.otherwise (exception.match? /.no_scope))) + (|> (do //phase.monad + [_ /.next] + (in false)) + (//phase.result state) + (exception.otherwise (exception.match? /.no_scope))))) + (_.cover [/.reset] + (and (|> /.next + (/.with_local [name/0 type/0]) + /.with + (//phase.result state) + (try#each (|>> product.right + (n.= 1))) + (try.else false)) + (|> /.next + /.reset + (/.with_local [name/0 type/0]) + /.with + (//phase.result state) + (try#each (|>> product.right + (n.= 0))) + (try.else false)))) + (_.cover [/.drained] + (|> (function (_ [bundle state]) + {try.#Success [[bundle (has .#scopes (list) state)] + false]}) + (/.with_local [name/0 type/0]) + /.with + (//phase#each product.right) + (//phase.result state) + (exception.otherwise (exception.match? /.drained)))) + (_.cover [/.with] + (|> (<| /.with (/.with_local [name/0 type/0]) - /.with - (//phase.result state) - (try#each (|>> product.right - (n.= 0))) - (try.else false)))) - (_.cover [/.drained] - (|> (function (_ [bundle state]) - {try.#Success [[bundle (has .#scopes (list) state)] - false]}) - (/.with_local [name/0 type/0]) - /.with - (//phase#each product.right) - (//phase.result state) - (exception.otherwise (exception.match? /.drained)))) - (_.cover [/.with] - (|> (<| /.with - (/.with_local [name/0 type/0]) - (do //phase.monad - [var/0' (/.variable name/0) - [scope/1 var/0''] (/.with (/.variable name/0))] - (<| //phase.lifted - try.of_maybe - (do maybe.monad - [var/0' var/0' - var/0'' var/0''] - (in [var/0' scope/1 var/0'']))))) - (//phase.result state) - (try#each (function (_ [scope/0 var/0' scope/1 var/0'']) - (and (local? type/0 0 var/0') - (n.= 0 (list.size (the [.#locals .#mappings] scope/0))) - (n.= 0 (list.size (the [.#captured .#mappings] scope/0))) + (do //phase.monad + [var/0' (/.variable name/0) + [scope/1 var/0''] (/.with (/.variable name/0))] + (<| //phase.lifted + try.of_maybe + (do maybe.monad + [var/0' var/0' + var/0'' var/0''] + (in [var/0' scope/1 var/0'']))))) + (//phase.result state) + (try#each (function (_ [scope/0 var/0' scope/1 var/0'']) + (and (local? type/0 0 var/0') + (n.= 0 (list.size (the [.#locals .#mappings] scope/0))) + (n.= 0 (list.size (the [.#captured .#mappings] scope/0))) - (foreign? type/0 0 var/0'') - (n.= 0 (list.size (the [.#locals .#mappings] scope/1))) - (n.= 1 (list.size (the [.#captured .#mappings] scope/1)))))) - (try.else false))) - (_.cover [/.environment] - (let [(open "list#[0]") (list.equivalence //variable.equivalence)] - (and (|> (<| /.with - (/.with_local [name/0 type/0]) - (/.with_local [name/1 type/1]) - (do //phase.monad - [[scope/1 _] (/.with (in []))] - (in (/.environment scope/1)))) - (//phase.result state) - (try#each (|>> product.right - (list#= (list)))) - (try.else false)) - (|> (<| /.with - (do [! //phase.monad] - [register/0 /.next]) - (/.with_local [name/0 type/0]) - (/.with_local [name/1 type/1]) - (do ! - [[scope/1 _] (/.with (/.variable name/0))] - (in [register/0 (/.environment scope/1)]))) - (//phase.result state) - (try#each (function (_ [_ [register/0 environment]]) - (list#= (list {//variable.#Local register/0}) - environment))) - (try.else false)) - (|> (<| /.with - (do [! //phase.monad] - [register/0 /.next]) - (/.with_local [name/0 type/0]) - (do [! //phase.monad] - [register/1 /.next]) - (/.with_local [name/1 type/1]) - (do [! //phase.monad] - [[scope/1 _] (/.with (do ! - [_ (/.variable name/1) - _ (/.variable name/0)] - (in [])))] - (in [register/0 register/1 (/.environment scope/1)]))) - (//phase.result state) - (try#each (function (_ [_ [register/0 register/1 environment]]) - (list#= (list {//variable.#Local register/1} - {//variable.#Local register/0}) - environment))) - (try.else false))))) - )))) + (foreign? type/0 0 var/0'') + (n.= 0 (list.size (the [.#locals .#mappings] scope/1))) + (n.= 1 (list.size (the [.#captured .#mappings] scope/1)))))) + (try.else false))) + (_.cover [/.environment] + (let [(open "list#[0]") (list.equivalence //variable.equivalence)] + (and (|> (<| /.with + (/.with_local [name/0 type/0]) + (/.with_local [name/1 type/1]) + (do //phase.monad + [[scope/1 _] (/.with (in []))] + (in (/.environment scope/1)))) + (//phase.result state) + (try#each (|>> product.right + (list#= (list)))) + (try.else false)) + (|> (<| /.with + (do [! //phase.monad] + [register/0 /.next]) + (/.with_local [name/0 type/0]) + (/.with_local [name/1 type/1]) + (do ! + [[scope/1 _] (/.with (/.variable name/0))] + (in [register/0 (/.environment scope/1)]))) + (//phase.result state) + (try#each (function (_ [_ [register/0 environment]]) + (list#= (list {//variable.#Local register/0}) + environment))) + (try.else false)) + (|> (<| /.with + (do [! //phase.monad] + [register/0 /.next]) + (/.with_local [name/0 type/0]) + (do [! //phase.monad] + [register/1 /.next]) + (/.with_local [name/1 type/1]) + (do [! //phase.monad] + [[scope/1 _] (/.with (do ! + [_ (/.variable name/1) + _ (/.variable name/0)] + (in [])))] + (in [register/0 register/1 (/.environment scope/1)]))) + (//phase.result state) + (try#each (function (_ [_ [register/0 register/1 environment]]) + (list#= (list {//variable.#Local register/1} + {//variable.#Local register/0}) + environment))) + (try.else false))))) + )))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/simple.lux b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/simple.lux index e7c22559f..3542d79c7 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/simple.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/simple.lux @@ -18,28 +18,28 @@ (def: .public random (Random /.Simple) - ($_ random.or - (random#in []) - random.bit - random.nat - random.int - random.rev - (random.only (|>> f.not_a_number? not) random.frac) - (random.ascii/lower 5) - )) + (all random.or + (random#in []) + random.bit + random.nat + random.int + random.rev + (random.only (|>> f.not_a_number? not) random.frac) + (random.ascii/lower 5) + )) (def: .public test Test (<| (_.covering /._) (_.for [/.Simple]) - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) - - (do random.monad - [left ..random - right ..random] - (_.cover [/.format] - (bit#= (# /.equivalence = left right) - (text#= (/.format left) (/.format right))))) - ))) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + + (do random.monad + [left ..random + right ..random] + (_.cover [/.format] + (bit#= (# /.equivalence = left right) + (text#= (/.format left) (/.format right))))) + ))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/type.lux b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/type.lux index 2a13b674c..750bade83 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/type.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/type.lux @@ -51,85 +51,85 @@ dummy (random.only (|>> (type#= expected) not) ..primitive) module (random.ascii/lower 1)] - ($_ _.and - (_.cover [/.expecting /.inference] - (and (|> (/.inference expected) - (/.expecting expected) - (/module.with 0 module) - (/phase#each product.right) - (/phase.result state) - (pipe.case - {try.#Success _} true - {try.#Failure _} false)) - (|> (/.inference dummy) - (/.expecting expected) - (/module.with 0 module) - (/phase#each product.right) - (/phase.result state) - (pipe.case - {try.#Success _} false - {try.#Failure _} true)) - (|> (/.inference expected) - (/.expecting dummy) - (/module.with 0 module) - (/phase#each product.right) - (/phase.result state) - (pipe.case - {try.#Success _} false - {try.#Failure _} true)))) - (_.cover [/.inferring] - (|> (/.inference expected) - /.inferring - (/module.with 0 module) - (/phase#each product.right) - (/phase.result state) - (try#each (|>> product.left (type#= expected))) - (try.else false))) - (_.cover [/.check] - (|> (do /phase.monad - [exT (/.check (do check.monad - [[id type] check.existential] - (in type)))] - (|> (/.inference exT) - (/.expecting exT))) - (/module.with 0 module) - (/phase#each product.right) - (/phase.result state) - (pipe.case - {try.#Success _} true - {try.#Failure _} false))) - (_.cover [/.existential /.existential?] - (|> (do /phase.monad - [:it: /.existential] - (in (/.existential? :it:))) - (/module.with 0 module) - (/phase#each product.right) - (/phase.result state) - (try.else false))) - (_.cover [/.fresh] - (and (|> (do /phase.monad - [varT (/.check (do check.monad - [[id type] check.var] - (in type)))] - (|> (/.inference expected) - (/.expecting varT))) - (/module.with 0 module) - (/phase#each product.right) - (/phase.result state) - (pipe.case - {try.#Success _} true - {try.#Failure _} false)) - (|> (do /phase.monad - [varT (/.check (do check.monad - [[id type] check.var] - (in type)))] - (|> (/.inference expected) - (/.expecting varT) - /.fresh)) - (/module.with 0 module) - (/phase#each product.right) - (/phase.result state) - (pipe.case - {try.#Success _} false - {try.#Failure _} true)))) - )))) + (all _.and + (_.cover [/.expecting /.inference] + (and (|> (/.inference expected) + (/.expecting expected) + (/module.with 0 module) + (/phase#each product.right) + (/phase.result state) + (pipe.case + {try.#Success _} true + {try.#Failure _} false)) + (|> (/.inference dummy) + (/.expecting expected) + (/module.with 0 module) + (/phase#each product.right) + (/phase.result state) + (pipe.case + {try.#Success _} false + {try.#Failure _} true)) + (|> (/.inference expected) + (/.expecting dummy) + (/module.with 0 module) + (/phase#each product.right) + (/phase.result state) + (pipe.case + {try.#Success _} false + {try.#Failure _} true)))) + (_.cover [/.inferring] + (|> (/.inference expected) + /.inferring + (/module.with 0 module) + (/phase#each product.right) + (/phase.result state) + (try#each (|>> product.left (type#= expected))) + (try.else false))) + (_.cover [/.check] + (|> (do /phase.monad + [exT (/.check (do check.monad + [[id type] check.existential] + (in type)))] + (|> (/.inference exT) + (/.expecting exT))) + (/module.with 0 module) + (/phase#each product.right) + (/phase.result state) + (pipe.case + {try.#Success _} true + {try.#Failure _} false))) + (_.cover [/.existential /.existential?] + (|> (do /phase.monad + [:it: /.existential] + (in (/.existential? :it:))) + (/module.with 0 module) + (/phase#each product.right) + (/phase.result state) + (try.else false))) + (_.cover [/.fresh] + (and (|> (do /phase.monad + [varT (/.check (do check.monad + [[id type] check.var] + (in type)))] + (|> (/.inference expected) + (/.expecting varT))) + (/module.with 0 module) + (/phase#each product.right) + (/phase.result state) + (pipe.case + {try.#Success _} true + {try.#Failure _} false)) + (|> (do /phase.monad + [varT (/.check (do check.monad + [[id type] check.var] + (in type)))] + (|> (/.inference expected) + (/.expecting varT) + /.fresh)) + (/module.with 0 module) + (/phase#each product.right) + (/phase.result state) + (pipe.case + {try.#Success _} false + {try.#Failure _} true)))) + )))) 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 d14a481fa..e4e903891 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 @@ -921,46 +921,46 @@ $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) - (..can_analyse_simple_literal_or_singleton_tuple! lux module/0 [bit/0 nat/0 int/0 rev/0 frac/0 text/0]) - (..can_analyse_sum! lux module/0 [@any @bit @nat @int @rev @frac @text] [bit/0 nat/0 int/0 rev/0 frac/0 text/0] [@left @right]) - (..can_analyse_variant! lux module/0 [@any @bit @nat @int @rev @frac @text] [bit/0 nat/0 int/0 rev/0 frac/0 text/0] [@left @right]) - (..can_analyse_tuple! lux module/0 [bit/0 nat/0 int/0 rev/0 frac/0 text/0]) - (..can_analyse_record! lux module/0 [@any @bit @nat @int @rev @frac @text] [bit/0 nat/0 int/0 rev/0 frac/0 text/0]) - (..can_analyse_function! lux module/0 nat/0 [$abstraction/0 $parameter/0 $abstraction/1 $parameter/1]) - (..can_analyse_apply! lux module/0 bit/0 nat/0 [$abstraction/0 $parameter/0 $abstraction/1 $parameter/1]) - (..can_analyse_extension! lux module/0 text/0) - (..can_analyse_pattern_matching! lux module/0 [@any @bit @nat @int @rev @frac @text] [bit/0 nat/0 int/0 rev/0 frac/0 text/0] $parameter/0) - )) - (_.cover [/.invalid] - (`` (and (~~ (template [<syntax>] - [(|> (do phase.monad - [_ (|> <syntax> - (/.phase ..expander archive.empty) - (//type.expecting .Any))] - (in false)) - //scope.with - (//module.with 0 module/0) - (phase#each (|>> product.right product.right)) - (phase.result state) - (exception.otherwise (text.contains? (the exception.#label /.invalid))))] - - [(` ({#0} (~ (code.bit bit/0))))] - [(` ({#0 [] #1} (~ (code.bit bit/0))))] - [(` {(~ (code.bit bit/0)) (~ (code.nat nat/0)) (~ (code.int int/0)) (~ (code.rev rev/0)) (~ (code.frac frac/0)) (~ (code.text text/0))})] - [(` {(~ (code.nat nat/0)) (~ (code.int int/0)) (~ (code.rev rev/0)) (~ (code.frac frac/0)) (~ (code.text text/0)) (~ (code.bit bit/0))})] - [(` {(~ (code.int int/0)) (~ (code.rev rev/0)) (~ (code.frac frac/0)) (~ (code.text text/0)) (~ (code.bit bit/0)) (~ (code.nat nat/0))})] - [(` {(~ (code.rev rev/0)) (~ (code.frac frac/0)) (~ (code.text text/0)) (~ (code.bit bit/0)) (~ (code.nat nat/0)) (~ (code.int int/0))})] - [(` {(~ (code.frac frac/0)) (~ (code.text text/0)) (~ (code.bit bit/0)) (~ (code.nat nat/0)) (~ (code.int int/0)) (~ (code.rev rev/0))})] - [(` {(~ (code.text text/0)) (~ (code.bit bit/0)) (~ (code.nat nat/0)) (~ (code.int int/0)) (~ (code.rev rev/0)) (~ (code.frac frac/0))})] - )) - ))) - - /simple.test - /complex.test - /reference.test - /function.test - /case.test - ))) + (all _.and + (_.cover [/.phase] + (and (..can_analyse_unit! lux module/0) + (..can_analyse_simple_literal_or_singleton_tuple! lux module/0 [bit/0 nat/0 int/0 rev/0 frac/0 text/0]) + (..can_analyse_sum! lux module/0 [@any @bit @nat @int @rev @frac @text] [bit/0 nat/0 int/0 rev/0 frac/0 text/0] [@left @right]) + (..can_analyse_variant! lux module/0 [@any @bit @nat @int @rev @frac @text] [bit/0 nat/0 int/0 rev/0 frac/0 text/0] [@left @right]) + (..can_analyse_tuple! lux module/0 [bit/0 nat/0 int/0 rev/0 frac/0 text/0]) + (..can_analyse_record! lux module/0 [@any @bit @nat @int @rev @frac @text] [bit/0 nat/0 int/0 rev/0 frac/0 text/0]) + (..can_analyse_function! lux module/0 nat/0 [$abstraction/0 $parameter/0 $abstraction/1 $parameter/1]) + (..can_analyse_apply! lux module/0 bit/0 nat/0 [$abstraction/0 $parameter/0 $abstraction/1 $parameter/1]) + (..can_analyse_extension! lux module/0 text/0) + (..can_analyse_pattern_matching! lux module/0 [@any @bit @nat @int @rev @frac @text] [bit/0 nat/0 int/0 rev/0 frac/0 text/0] $parameter/0) + )) + (_.cover [/.invalid] + (`` (and (~~ (template [<syntax>] + [(|> (do phase.monad + [_ (|> <syntax> + (/.phase ..expander archive.empty) + (//type.expecting .Any))] + (in false)) + //scope.with + (//module.with 0 module/0) + (phase#each (|>> product.right product.right)) + (phase.result state) + (exception.otherwise (text.contains? (the exception.#label /.invalid))))] + + [(` ({#0} (~ (code.bit bit/0))))] + [(` ({#0 [] #1} (~ (code.bit bit/0))))] + [(` {(~ (code.bit bit/0)) (~ (code.nat nat/0)) (~ (code.int int/0)) (~ (code.rev rev/0)) (~ (code.frac frac/0)) (~ (code.text text/0))})] + [(` {(~ (code.nat nat/0)) (~ (code.int int/0)) (~ (code.rev rev/0)) (~ (code.frac frac/0)) (~ (code.text text/0)) (~ (code.bit bit/0))})] + [(` {(~ (code.int int/0)) (~ (code.rev rev/0)) (~ (code.frac frac/0)) (~ (code.text text/0)) (~ (code.bit bit/0)) (~ (code.nat nat/0))})] + [(` {(~ (code.rev rev/0)) (~ (code.frac frac/0)) (~ (code.text text/0)) (~ (code.bit bit/0)) (~ (code.nat nat/0)) (~ (code.int int/0))})] + [(` {(~ (code.frac frac/0)) (~ (code.text text/0)) (~ (code.bit bit/0)) (~ (code.nat nat/0)) (~ (code.int int/0)) (~ (code.rev rev/0))})] + [(` {(~ (code.text text/0)) (~ (code.bit bit/0)) (~ (code.nat nat/0)) (~ (code.int int/0)) (~ (code.rev rev/0)) (~ (code.frac frac/0))})] + )) + ))) + + /simple.test + /complex.test + /reference.test + /function.test + /case.test + ))) 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 c7272d0cc..42c064bbc 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 @@ -66,79 +66,79 @@ $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) - (function (_ :input: :expected:) - (and (|> :input: - /.tuple - (check.result check.fresh_context) - (try#each (|>> product.right (type#= :expected:))) - (try.else false)) - (|> (do check.monad - [[@var :var:] check.var - _ (check.check :var: :input:)] - (/.tuple :var:)) - (check.result check.fresh_context) - (try#each (|>> product.right (type#= :expected:))) - (try.else false)))))] - (and (tuple? input/0 - (type.anonymous input/0)) - (tuple? (Tuple input/0 input/1 input/2) - (Tuple input/0 input/1 input/2)) - (tuple? {.#Named name/0 (Tuple input/0 input/1 input/2)} - (Tuple input/0 input/1 input/2)) - (tuple? (All (_ a b c) (Tuple input/0 input/1 input/2)) - (Tuple (All (_ a b c) input/0) - (All (_ a b c) input/1) - (All (_ a b c) input/2))) - (tuple? (type ((All (_ a b c) (Tuple a b c)) input/0 input/1 input/2)) - (Tuple input/0 input/1 input/2)) - (|> (do check.monad - [[@var :var:] check.var - _ (check.bind (All (_ a b c) (Tuple a b c)) @var)] - (/.tuple (type (:var: input/0 input/1 input/2)))) - (check.result check.fresh_context) - (try#each (|>> product.right (type#= (Tuple input/0 input/1 input/2)))) - (try.else false)) - (|> (do check.monad - [[@0 :0:] check.existential - [@1 :1:] check.existential - [_ :tuple:] (/.tuple (Ex (_ a b c) (Tuple a input/1 c))) - context check.context - _ (check.with context) - _ (check.check (Tuple :0: input/1 :1:) :tuple:) - _ (check.with context) - _ (check.check :tuple: (Tuple :0: input/1 :1:))] - (in true)) - (check.result check.fresh_context) - (try.else false))))) - (_.cover [/.non_tuple] - (and (|> (do check.monad - [[@var :var:] check.var - _ (/.tuple :var:)] - (in false)) - (check.result check.fresh_context) - (exception.otherwise (text.contains? (the exception.#label /.non_tuple)))) - (|> (do check.monad - [[@var :var:] check.var - _ (/.tuple (type (:var: input/0 input/1 input/2)))] - (in false)) - (check.result check.fresh_context) - (exception.otherwise (text.contains? (the exception.#label /.non_tuple)))) - (|> (do check.monad - [_ (/.tuple (type (input/0 input/1 input/2)))] - (in false)) - (check.result check.fresh_context) - (exception.otherwise (text.contains? (the exception.#label /.non_tuple)))) - (|> (do check.monad - [[@var :var:] check.var - _ (check.bind input/0 @var) - _ (/.tuple (type (:var: input/1 input/2)))] - (in false)) - (check.result check.fresh_context) - (exception.otherwise (text.contains? (the exception.#label /.non_tuple)))))) - ))) + (all _.and + (_.cover [/.tuple] + (let [tuple? (is (-> Type Type Bit) + (function (_ :input: :expected:) + (and (|> :input: + /.tuple + (check.result check.fresh_context) + (try#each (|>> product.right (type#= :expected:))) + (try.else false)) + (|> (do check.monad + [[@var :var:] check.var + _ (check.check :var: :input:)] + (/.tuple :var:)) + (check.result check.fresh_context) + (try#each (|>> product.right (type#= :expected:))) + (try.else false)))))] + (and (tuple? input/0 + (type.anonymous input/0)) + (tuple? (Tuple input/0 input/1 input/2) + (Tuple input/0 input/1 input/2)) + (tuple? {.#Named name/0 (Tuple input/0 input/1 input/2)} + (Tuple input/0 input/1 input/2)) + (tuple? (All (_ a b c) (Tuple input/0 input/1 input/2)) + (Tuple (All (_ a b c) input/0) + (All (_ a b c) input/1) + (All (_ a b c) input/2))) + (tuple? (type ((All (_ a b c) (Tuple a b c)) input/0 input/1 input/2)) + (Tuple input/0 input/1 input/2)) + (|> (do check.monad + [[@var :var:] check.var + _ (check.bind (All (_ a b c) (Tuple a b c)) @var)] + (/.tuple (type (:var: input/0 input/1 input/2)))) + (check.result check.fresh_context) + (try#each (|>> product.right (type#= (Tuple input/0 input/1 input/2)))) + (try.else false)) + (|> (do check.monad + [[@0 :0:] check.existential + [@1 :1:] check.existential + [_ :tuple:] (/.tuple (Ex (_ a b c) (Tuple a input/1 c))) + context check.context + _ (check.with context) + _ (check.check (Tuple :0: input/1 :1:) :tuple:) + _ (check.with context) + _ (check.check :tuple: (Tuple :0: input/1 :1:))] + (in true)) + (check.result check.fresh_context) + (try.else false))))) + (_.cover [/.non_tuple] + (and (|> (do check.monad + [[@var :var:] check.var + _ (/.tuple :var:)] + (in false)) + (check.result check.fresh_context) + (exception.otherwise (text.contains? (the exception.#label /.non_tuple)))) + (|> (do check.monad + [[@var :var:] check.var + _ (/.tuple (type (:var: input/0 input/1 input/2)))] + (in false)) + (check.result check.fresh_context) + (exception.otherwise (text.contains? (the exception.#label /.non_tuple)))) + (|> (do check.monad + [_ (/.tuple (type (input/0 input/1 input/2)))] + (in false)) + (check.result check.fresh_context) + (exception.otherwise (text.contains? (the exception.#label /.non_tuple)))) + (|> (do check.monad + [[@var :var:] check.var + _ (check.bind input/0 @var) + _ (/.tuple (type (:var: input/1 input/2)))] + (in false)) + (check.result check.fresh_context) + (exception.otherwise (text.contains? (the exception.#label /.non_tuple)))))) + ))) (def: (test|case lux [module/0 name/0] [input/0 simple/0] [input/1 simple/1] [input/2 simple/2] [$binding/0 $binding/1 $binding/2] [output/0 body/0] [output/1 body/1] [bit/0 nat/0]) (-> Lux Symbol [Type Code] [Type Code] [Type Code] [Code Code Code] [Type Code] [Type Code] [Bit Nat] Bit) @@ -514,122 +514,122 @@ extension/0 (# ! each code.text (random.ascii/lower 6)) bit/0 random.bit nat/0 random.nat] - ($_ _.and - (_.cover [/.case] - (and (test|case lux [module/0 name/0] [input/0 simple/0] [input/1 simple/1] [input/2 simple/2] [$binding/0 $binding/1 $binding/2] [output/0 body/0] [output/1 body/1] [bit/0 nat/0]) - (test|redundancy lux [module/0 name/0] [input/0 simple/0] [input/1 simple/1] [input/2 simple/1] [$binding/0 $binding/1 $binding/2] [output/0 body/0] [bit/0]) - (test|variant lux [module/0 name/0] [input/0 simple/0] [input/1 simple/1] [input/2 simple/2] [$binding/0 $binding/1 $binding/2] [output/0 body/0] [output/1 body/1] [bit/0 nat/0]) - (test|record lux [module/0 name/0] [input/0 simple/0] [input/1 simple/1] [input/2 simple/2] [$binding/0 $binding/1 $binding/2] [output/0 body/0] [output/1 body/1] [bit/0 nat/0]))) - (_.cover [/.empty_branches] - (|> (do //phase.monad - [analysis (|> (/.case ..analysis (list) archive.empty simple/0) - (//type.expecting output/0))] - (in false)) - //scope.with - (//module.with 0 module/0) - (//phase#each (|>> product.right product.right)) - (//phase.result state) - (exception.otherwise (text.contains? (the exception.#label /.empty_branches))))) - (_.cover [/.non_exhaustive] - (let [non_exhaustive? (is (-> (List [Code Code]) Bit) - (function (_ branches) - (|> (do //phase.monad - [analysis (|> (/.case ..analysis branches archive.empty simple/0) - (//type.expecting output/0))] - (in false)) - //scope.with - (//module.with 0 module/0) - (//phase#each (|>> product.right product.right)) - (//phase.result state) - (exception.otherwise (text.contains? (the exception.#label /.non_exhaustive))))))] - (and (non_exhaustive? (list [simple/0 body/0])) - (not (non_exhaustive? (list [simple/0 body/0] - [$binding/0 body/0])))))) - (_.cover [/.invalid] - (let [invalid? (is (-> (List [Code Code]) Bit) - (function (_ branches) - (|> (do //phase.monad - [analysis (|> (/.case ..analysis branches archive.empty simple/0) - (//type.expecting output/0))] - (in false)) - //scope.with - (//module.with 0 module/0) - (//phase#each (|>> product.right product.right)) - (//phase.result state) - (exception.otherwise (text.contains? (the exception.#label /.invalid))))))] - (and (invalid? (list [(` ((~ extension/0) (~ $binding/0) (~ $binding/1) (~ $binding/2))) - body/0])) - (invalid? (list [(` {(~ extension/0) (~ $binding/0) (~ $binding/1) (~ $binding/2)}) - body/0])) - (invalid? (list [(` {[] (~ $binding/0) (~ $binding/1) (~ $binding/2)}) - body/0]))))) - (_.cover [/.sum_has_no_case] - (let [tag/0 (%.code $binding/0) - tag/1 (%.code $binding/1) - tag/2 (%.code $binding/2) - - tags/* (list tag/0 tag/1 tag/2) - :variant: {.#Named [module/0 name/0] (type.variant (list input/0 input/1 input/2))} - - tag/0 (code.symbol [module/0 tag/0]) - tag/1 (code.symbol [module/0 tag/1]) - tag/2 (code.symbol [module/0 tag/2])] - (|> (do //phase.monad - [_ (//module.declare_labels false tags/* false :variant:) - analysis (|> (` {(~ tag/0) (~ simple/0)}) - (/.case ..analysis - (list [(` {0 #0 (~ $binding/0)}) body/0] - [(` {1 #0 (~ $binding/1)}) body/0] - [(` {2 #0 (~ $binding/2)}) body/0] - [(` {2 #1 (~ $binding/2)}) body/0]) - archive.empty) - (//type.expecting output/0))] - (in false)) - //scope.with - (//module.with 0 module/0) - (//phase#each (|>> product.right product.right)) - (//phase.result state) - (exception.otherwise (text.contains? (the exception.#label /.sum_has_no_case)))))) - (_.cover [/.mismatch] - (let [slot/0 (%.code $binding/0) - slot/1 (%.code $binding/1) - slot/2 (%.code $binding/2) - - slots/* (list slot/0 slot/1 slot/2) - :record: {.#Named [module/0 name/0] (type.tuple (list input/0 input/1 input/2))} - - slot/0 (code.symbol [module/0 slot/0]) - slot/1 (code.symbol [module/0 slot/1]) - slot/2 (code.symbol [module/0 slot/2])] - (and (|> (do //phase.monad - [analysis (|> (` (~ simple/0)) - (/.case ..analysis - (list [(` {0 #0 (~ $binding/0)}) body/0] - [(` {1 #0 (~ $binding/1)}) body/0] - [(` {1 #1 (~ $binding/2)}) body/0]) - archive.empty) - (//type.expecting output/0))] - (in false)) - //scope.with - (//module.with 0 module/0) - (//phase#each (|>> product.right product.right)) - (//phase.result state) - (exception.otherwise (text.contains? (the exception.#label /.mismatch)))) - (|> (do //phase.monad - [_ (//module.declare_labels true slots/* false :record:) - analysis (|> (` (~ simple/0)) - (/.case ..analysis - (list [(` [(~ slot/0) (~ $binding/0) - (~ slot/1) (~ $binding/1) - (~ slot/2) (~ $binding/2)]) body/0]) - archive.empty) - (//type.expecting output/0))] - (in false)) - //scope.with - (//module.with 0 module/0) - (//phase#each (|>> product.right product.right)) - (//phase.result state) - (exception.otherwise (text.contains? (the exception.#label /.mismatch))))))) - - ..test|tuple - )))) + (all _.and + (_.cover [/.case] + (and (test|case lux [module/0 name/0] [input/0 simple/0] [input/1 simple/1] [input/2 simple/2] [$binding/0 $binding/1 $binding/2] [output/0 body/0] [output/1 body/1] [bit/0 nat/0]) + (test|redundancy lux [module/0 name/0] [input/0 simple/0] [input/1 simple/1] [input/2 simple/1] [$binding/0 $binding/1 $binding/2] [output/0 body/0] [bit/0]) + (test|variant lux [module/0 name/0] [input/0 simple/0] [input/1 simple/1] [input/2 simple/2] [$binding/0 $binding/1 $binding/2] [output/0 body/0] [output/1 body/1] [bit/0 nat/0]) + (test|record lux [module/0 name/0] [input/0 simple/0] [input/1 simple/1] [input/2 simple/2] [$binding/0 $binding/1 $binding/2] [output/0 body/0] [output/1 body/1] [bit/0 nat/0]))) + (_.cover [/.empty_branches] + (|> (do //phase.monad + [analysis (|> (/.case ..analysis (list) archive.empty simple/0) + (//type.expecting output/0))] + (in false)) + //scope.with + (//module.with 0 module/0) + (//phase#each (|>> product.right product.right)) + (//phase.result state) + (exception.otherwise (text.contains? (the exception.#label /.empty_branches))))) + (_.cover [/.non_exhaustive] + (let [non_exhaustive? (is (-> (List [Code Code]) Bit) + (function (_ branches) + (|> (do //phase.monad + [analysis (|> (/.case ..analysis branches archive.empty simple/0) + (//type.expecting output/0))] + (in false)) + //scope.with + (//module.with 0 module/0) + (//phase#each (|>> product.right product.right)) + (//phase.result state) + (exception.otherwise (text.contains? (the exception.#label /.non_exhaustive))))))] + (and (non_exhaustive? (list [simple/0 body/0])) + (not (non_exhaustive? (list [simple/0 body/0] + [$binding/0 body/0])))))) + (_.cover [/.invalid] + (let [invalid? (is (-> (List [Code Code]) Bit) + (function (_ branches) + (|> (do //phase.monad + [analysis (|> (/.case ..analysis branches archive.empty simple/0) + (//type.expecting output/0))] + (in false)) + //scope.with + (//module.with 0 module/0) + (//phase#each (|>> product.right product.right)) + (//phase.result state) + (exception.otherwise (text.contains? (the exception.#label /.invalid))))))] + (and (invalid? (list [(` ((~ extension/0) (~ $binding/0) (~ $binding/1) (~ $binding/2))) + body/0])) + (invalid? (list [(` {(~ extension/0) (~ $binding/0) (~ $binding/1) (~ $binding/2)}) + body/0])) + (invalid? (list [(` {[] (~ $binding/0) (~ $binding/1) (~ $binding/2)}) + body/0]))))) + (_.cover [/.sum_has_no_case] + (let [tag/0 (%.code $binding/0) + tag/1 (%.code $binding/1) + tag/2 (%.code $binding/2) + + tags/* (list tag/0 tag/1 tag/2) + :variant: {.#Named [module/0 name/0] (type.variant (list input/0 input/1 input/2))} + + tag/0 (code.symbol [module/0 tag/0]) + tag/1 (code.symbol [module/0 tag/1]) + tag/2 (code.symbol [module/0 tag/2])] + (|> (do //phase.monad + [_ (//module.declare_labels false tags/* false :variant:) + analysis (|> (` {(~ tag/0) (~ simple/0)}) + (/.case ..analysis + (list [(` {0 #0 (~ $binding/0)}) body/0] + [(` {1 #0 (~ $binding/1)}) body/0] + [(` {2 #0 (~ $binding/2)}) body/0] + [(` {2 #1 (~ $binding/2)}) body/0]) + archive.empty) + (//type.expecting output/0))] + (in false)) + //scope.with + (//module.with 0 module/0) + (//phase#each (|>> product.right product.right)) + (//phase.result state) + (exception.otherwise (text.contains? (the exception.#label /.sum_has_no_case)))))) + (_.cover [/.mismatch] + (let [slot/0 (%.code $binding/0) + slot/1 (%.code $binding/1) + slot/2 (%.code $binding/2) + + slots/* (list slot/0 slot/1 slot/2) + :record: {.#Named [module/0 name/0] (type.tuple (list input/0 input/1 input/2))} + + slot/0 (code.symbol [module/0 slot/0]) + slot/1 (code.symbol [module/0 slot/1]) + slot/2 (code.symbol [module/0 slot/2])] + (and (|> (do //phase.monad + [analysis (|> (` (~ simple/0)) + (/.case ..analysis + (list [(` {0 #0 (~ $binding/0)}) body/0] + [(` {1 #0 (~ $binding/1)}) body/0] + [(` {1 #1 (~ $binding/2)}) body/0]) + archive.empty) + (//type.expecting output/0))] + (in false)) + //scope.with + (//module.with 0 module/0) + (//phase#each (|>> product.right product.right)) + (//phase.result state) + (exception.otherwise (text.contains? (the exception.#label /.mismatch)))) + (|> (do //phase.monad + [_ (//module.declare_labels true slots/* false :record:) + analysis (|> (` (~ simple/0)) + (/.case ..analysis + (list [(` [(~ slot/0) (~ $binding/0) + (~ slot/1) (~ $binding/1) + (~ slot/2) (~ $binding/2)]) body/0]) + archive.empty) + (//type.expecting output/0))] + (in false)) + //scope.with + (//module.with 0 module/0) + (//phase#each (|>> product.right product.right)) + (//phase.result state) + (exception.otherwise (text.contains? (the exception.#label /.mismatch))))))) + + ..test|tuple + )))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/complex.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/complex.lux index 7750db2ed..44fdae7eb 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/complex.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/complex.lux @@ -89,18 +89,18 @@ (def: simple_parameter (Random [Type Code]) - (`` ($_ random.either - (~~ (template [<type> <random> <code>] - [(random#each (|>> <code> [<type>]) <random>)] - - [.Bit random.bit code.bit] - [.Nat random.nat code.nat] - [.Int random.int code.int] - [.Rev random.rev code.rev] - [.Frac (random.only (|>> f.not_a_number? not) random.frac) code.frac] - [.Text (random.ascii/lower 1) code.text] - )) - ))) + (`` (all random.either + (~~ (template [<type> <random> <code>] + [(random#each (|>> <code> [<type>]) <random>)] + + [.Bit random.bit code.bit] + [.Nat random.nat code.nat] + [.Int random.int code.int] + [.Rev random.rev code.rev] + [.Frac (random.only (|>> f.not_a_number? not) random.frac) code.frac] + [.Text (random.ascii/lower 1) code.text] + )) + ))) (def: (analysed? expected actual) (-> Code Analysis Bit) @@ -141,75 +141,75 @@ [tagT tagC] (|> types/*,terms/* (list.item tag) (maybe.else [Any (' [])]))]] - ($_ _.and - (_.cover [/.sum] - (let [variantT (type.variant (list#each product.left types/*,terms/*)) - sum? (is (-> Type Nat Bit Code Bit) - (function (_ type lefts right? code) - (|> (do //phase.monad - [analysis (|> (/.sum ..analysis lefts right? archive.empty code) - (//type.expecting type))] - (in (case analysis - (pattern (//analysis.variant [lefts' right?' analysis])) - (and (n.= lefts lefts') - (bit#= right? right?') - (..analysed? code analysis)) - - _ - false))) - (//module.with 0 (product.left name)) - (//phase#each product.right) - (//phase.result state) - (try.else false))))] - (and (sum? variantT lefts right? tagC) - (sum? {.#Named name variantT} lefts right? tagC) - (|> (do //phase.monad - [[@var varT] (//type.check check.var) - _ (//type.check (check.check varT variantT)) - analysis (|> (/.sum ..analysis lefts right? archive.empty tagC) - (//type.expecting varT))] - (in (case analysis - (pattern (//analysis.variant [lefts' right?' it])) - (and (n.= lefts lefts') - (bit#= right? right?') - (..analysed? tagC it)) - - _ - false))) - (//module.with 0 (product.left name)) - (//phase#each product.right) - (//phase.result state) - (try.else false)) - (and (sum? (type (Maybe tagT)) 0 #0 (` [])) - (sum? (type (Maybe tagT)) 0 #1 tagC)) - (and (sum? (type (All (_ a) (Maybe a))) 0 #0 (` [])) - (not (sum? (type (All (_ a) (Maybe a))) 0 #1 tagC))) - (and (sum? (type (Ex (_ a) (Maybe a))) 0 #0 (` [])) - (sum? (type (Ex (_ a) (Maybe a))) 0 #1 tagC))))) - (_.for [/.cannot_analyse_variant] - (let [failure? (is (All (_ a) (-> (Exception a) (//analysis.Operation Any) Bit)) - (function (_ exception analysis) - (let [it (//phase.result state analysis)] - (and (..failure? /.cannot_analyse_variant it) - (..failure? exception it)))))] - ($_ _.and - (_.cover [/.invalid_variant_type] - (and (|> (/.sum ..analysis lefts right? archive.empty tagC) - (//type.expecting tagT) - (failure? /.invalid_variant_type)) + (all _.and + (_.cover [/.sum] + (let [variantT (type.variant (list#each product.left types/*,terms/*)) + sum? (is (-> Type Nat Bit Code Bit) + (function (_ type lefts right? code) (|> (do //phase.monad - [[@var varT] (//type.check check.var)] - (|> (/.sum ..analysis lefts right? archive.empty tagC) - (//type.expecting (type (varT tagT))))) - (failure? /.invalid_variant_type)))) - (_.cover [/.cannot_infer_sum] - (|> (do //phase.monad - [[@var varT] (//type.check check.var)] - (|> (/.sum ..analysis lefts right? archive.empty tagC) - (//type.expecting varT))) - (failure? /.cannot_infer_sum))) - ))) - ))) + [analysis (|> (/.sum ..analysis lefts right? archive.empty code) + (//type.expecting type))] + (in (case analysis + (pattern (//analysis.variant [lefts' right?' analysis])) + (and (n.= lefts lefts') + (bit#= right? right?') + (..analysed? code analysis)) + + _ + false))) + (//module.with 0 (product.left name)) + (//phase#each product.right) + (//phase.result state) + (try.else false))))] + (and (sum? variantT lefts right? tagC) + (sum? {.#Named name variantT} lefts right? tagC) + (|> (do //phase.monad + [[@var varT] (//type.check check.var) + _ (//type.check (check.check varT variantT)) + analysis (|> (/.sum ..analysis lefts right? archive.empty tagC) + (//type.expecting varT))] + (in (case analysis + (pattern (//analysis.variant [lefts' right?' it])) + (and (n.= lefts lefts') + (bit#= right? right?') + (..analysed? tagC it)) + + _ + false))) + (//module.with 0 (product.left name)) + (//phase#each product.right) + (//phase.result state) + (try.else false)) + (and (sum? (type (Maybe tagT)) 0 #0 (` [])) + (sum? (type (Maybe tagT)) 0 #1 tagC)) + (and (sum? (type (All (_ a) (Maybe a))) 0 #0 (` [])) + (not (sum? (type (All (_ a) (Maybe a))) 0 #1 tagC))) + (and (sum? (type (Ex (_ a) (Maybe a))) 0 #0 (` [])) + (sum? (type (Ex (_ a) (Maybe a))) 0 #1 tagC))))) + (_.for [/.cannot_analyse_variant] + (let [failure? (is (All (_ a) (-> (Exception a) (//analysis.Operation Any) Bit)) + (function (_ exception analysis) + (let [it (//phase.result state analysis)] + (and (..failure? /.cannot_analyse_variant it) + (..failure? exception it)))))] + (all _.and + (_.cover [/.invalid_variant_type] + (and (|> (/.sum ..analysis lefts right? archive.empty tagC) + (//type.expecting tagT) + (failure? /.invalid_variant_type)) + (|> (do //phase.monad + [[@var varT] (//type.check check.var)] + (|> (/.sum ..analysis lefts right? archive.empty tagC) + (//type.expecting (type (varT tagT))))) + (failure? /.invalid_variant_type)))) + (_.cover [/.cannot_infer_sum] + (|> (do //phase.monad + [[@var varT] (//type.check check.var)] + (|> (/.sum ..analysis lefts right? archive.empty tagC) + (//type.expecting varT))) + (failure? /.cannot_infer_sum))) + ))) + ))) (def: test|variant (do [! random.monad] @@ -233,53 +233,53 @@ tag (|> tags (list.item tag) (maybe.else ""))]] - ($_ _.and - (_.cover [/.variant] - (let [expected_variant? (is (-> Symbol Bit) - (function (_ tag) - (|> (do //phase.monad - [_ (//module.declare_labels false tags false variantT) - analysis (|> (/.variant ..analysis tag archive.empty tagC) - (//type.expecting variantT))] - (in (case analysis - (pattern (//analysis.variant [lefts' right?' analysis])) - (and (n.= lefts lefts') - (bit#= right? right?') - (..analysed? tagC analysis)) - - _ - false))) - (//module.with 0 module) - (//phase#each product.right) - (//phase.result state) - (try.else false)))) - inferred_variant? (is (-> Symbol Bit) - (function (_ tag) - (|> (do //phase.monad - [_ (//module.declare_labels false tags false variantT) - [actualT analysis] (|> (/.variant ..analysis tag archive.empty tagC) - //type.inferring)] - (in (case analysis - (pattern (//analysis.variant [lefts' right?' analysis])) - (and (n.= lefts lefts') - (bit#= right? right?') - (..analysed? tagC analysis) - (type#= variantT actualT)) - - _ - false))) - (//module.with 0 module) - (//phase#each product.right) - (//phase.result state) - (try.else false))))] - (and (expected_variant? [module tag]) - (expected_variant? ["" tag]) - (inferred_variant? [module tag]) - (inferred_variant? ["" tag]) - - ... TODO: Test what happens when tags are shadowed by local bindings. - ))) - ))) + (all _.and + (_.cover [/.variant] + (let [expected_variant? (is (-> Symbol Bit) + (function (_ tag) + (|> (do //phase.monad + [_ (//module.declare_labels false tags false variantT) + analysis (|> (/.variant ..analysis tag archive.empty tagC) + (//type.expecting variantT))] + (in (case analysis + (pattern (//analysis.variant [lefts' right?' analysis])) + (and (n.= lefts lefts') + (bit#= right? right?') + (..analysed? tagC analysis)) + + _ + false))) + (//module.with 0 module) + (//phase#each product.right) + (//phase.result state) + (try.else false)))) + inferred_variant? (is (-> Symbol Bit) + (function (_ tag) + (|> (do //phase.monad + [_ (//module.declare_labels false tags false variantT) + [actualT analysis] (|> (/.variant ..analysis tag archive.empty tagC) + //type.inferring)] + (in (case analysis + (pattern (//analysis.variant [lefts' right?' analysis])) + (and (n.= lefts lefts') + (bit#= right? right?') + (..analysed? tagC analysis) + (type#= variantT actualT)) + + _ + false))) + (//module.with 0 module) + (//phase#each product.right) + (//phase.result state) + (try.else false))))] + (and (expected_variant? [module tag]) + (expected_variant? ["" tag]) + (inferred_variant? [module tag]) + (inferred_variant? ["" tag]) + + ... TODO: Test what happens when tags are shadowed by local bindings. + ))) + ))) (type: (Triple a) [a a a]) @@ -298,135 +298,135 @@ .let [module (product.left name) productT (type.tuple (list#each product.left types/*,terms/*)) expected (list#each product.right types/*,terms/*)]] - ($_ _.and - (_.cover [/.product] - (let [product? (is (-> Type (List Code) Bit) - (function (_ type expected) - (|> (do //phase.monad - [analysis (|> expected + (all _.and + (_.cover [/.product] + (let [product? (is (-> Type (List Code) Bit) + (function (_ type expected) + (|> (do //phase.monad + [analysis (|> expected + (/.product ..analysis archive.empty) + (//type.expecting type))] + (in (case analysis + (pattern (//analysis.tuple actual)) + (and (n.= (list.size expected) + (list.size actual)) + (list.every? (function (_ [expected actual]) + (..analysed? expected actual)) + (list.zipped_2 expected actual))) + + _ + false))) + (//module.with 0 module) + (//phase#each product.right) + (//phase.result state) + (try.else false))))] + (and (product? productT expected) + (product? {.#Named name productT} expected) + (product? (type (Ex (_ a) [a a])) (list term/0 term/0)) + (not (product? (type (All (_ a) [a a])) (list term/0 term/0))) + (product? (type (Triple type/0)) (list term/0 term/0 term/0)) + (|> (do //phase.monad + [[@var varT] (//type.check check.var) + _ (//type.check (check.check varT productT)) + analysis (|> expected + (/.product ..analysis archive.empty) + (//type.expecting varT))] + (in (case analysis + (pattern (//analysis.tuple actual)) + (and (n.= (list.size expected) + (list.size actual)) + (list.every? (function (_ [expected actual]) + (..analysed? expected actual)) + (list.zipped_2 expected actual))) + + _ + false))) + (//module.with 0 module) + (//phase#each product.right) + (//phase.result state) + (try.else false)) + (|> (do //phase.monad + [[:inferred: analysis] (|> expected (/.product ..analysis archive.empty) - (//type.expecting type))] - (in (case analysis - (pattern (//analysis.tuple actual)) - (and (n.= (list.size expected) - (list.size actual)) - (list.every? (function (_ [expected actual]) - (..analysed? expected actual)) - (list.zipped_2 expected actual))) - - _ - false))) - (//module.with 0 module) - (//phase#each product.right) - (//phase.result state) - (try.else false))))] - (and (product? productT expected) - (product? {.#Named name productT} expected) - (product? (type (Ex (_ a) [a a])) (list term/0 term/0)) - (not (product? (type (All (_ a) [a a])) (list term/0 term/0))) - (product? (type (Triple type/0)) (list term/0 term/0 term/0)) - (|> (do //phase.monad - [[@var varT] (//type.check check.var) - _ (//type.check (check.check varT productT)) - analysis (|> expected - (/.product ..analysis archive.empty) - (//type.expecting varT))] - (in (case analysis - (pattern (//analysis.tuple actual)) - (and (n.= (list.size expected) - (list.size actual)) - (list.every? (function (_ [expected actual]) - (..analysed? expected actual)) - (list.zipped_2 expected actual))) - - _ - false))) - (//module.with 0 module) - (//phase#each product.right) - (//phase.result state) - (try.else false)) - (|> (do //phase.monad - [[:inferred: analysis] (|> expected - (/.product ..analysis archive.empty) - //type.inferring)] - (in (case analysis - (pattern (//analysis.tuple actual)) - (and (n.= (list.size expected) - (list.size actual)) - (list.every? (function (_ [expected actual]) - (..analysed? expected actual)) - (list.zipped_2 expected actual)) - (type#= productT :inferred:)) - - _ - false))) - (//module.with 0 module) - (//phase#each product.right) - (//phase.result state) - (try.else false)) - (|> (do [! //phase.monad] - [[@var varT] (//type.check check.var) - [:inferred: analysis] (//type.inferring - (do ! - [_ (//type.inference (Tuple type/0 type/1 varT))] - (/.product ..analysis archive.empty - (list term/0 term/1 term/2 term/2 term/2)))) - :inferred: (//type.check (check.clean (list @var) :inferred:))] - (in (case analysis - (pattern (//analysis.tuple (list analysis/0 analysis/1 (//analysis.tuple (list analysis/2 analysis/3 analysis/4))))) - (and (type#= (Tuple type/0 type/1 type/2 type/2 type/2) - :inferred:) - (..analysed? term/0 analysis/0) - (..analysed? term/1 analysis/1) - (..analysed? term/2 analysis/2) - (..analysed? term/2 analysis/3) - (..analysed? term/2 analysis/4)) - - _ - false))) - (//module.with 0 module) - (//phase#each product.right) - (//phase.result state) - (try.else false)) - (|> (do [! //phase.monad] - [analysis (|> (list term/0 term/1 (code.tuple (list term/2 term/2 term/2))) - (/.product ..analysis archive.empty) - (//type.expecting (Tuple type/0 type/1 type/2 type/2 type/2)))] - (in (case analysis - (pattern (//analysis.tuple (list analysis/0 analysis/1 (//analysis.tuple (list analysis/2 analysis/3 analysis/4))))) - (and (..analysed? term/0 analysis/0) - (..analysed? term/1 analysis/1) - (..analysed? term/2 analysis/2) - (..analysed? term/2 analysis/3) - (..analysed? term/2 analysis/4)) - - _ - false))) - (//module.with 0 module) - (//phase#each product.right) - (//phase.result state) - (try.else false))))) - (_.for [/.cannot_analyse_tuple] - (_.cover [/.invalid_tuple_type] - (let [failure? (is (All (_ a) (-> (Exception a) (//analysis.Operation Any) Bit)) - (function (_ exception operation) - (let [it (//phase.result state operation)] - (and (..failure? /.cannot_analyse_tuple it) - (..failure? exception it)))))] - (and (|> expected - (/.product ..analysis archive.empty) - (//type.expecting (|> types/*,terms/* - list.head - (maybe#each product.left) - (maybe.else .Any))) - (failure? /.invalid_tuple_type)) - (|> (do //phase.monad - [[@var varT] (//type.check check.var)] - (|> expected - (/.product ..analysis archive.empty) - (//type.expecting (type (varT type/0))))) - (failure? /.invalid_tuple_type)))))) - ))) + //type.inferring)] + (in (case analysis + (pattern (//analysis.tuple actual)) + (and (n.= (list.size expected) + (list.size actual)) + (list.every? (function (_ [expected actual]) + (..analysed? expected actual)) + (list.zipped_2 expected actual)) + (type#= productT :inferred:)) + + _ + false))) + (//module.with 0 module) + (//phase#each product.right) + (//phase.result state) + (try.else false)) + (|> (do [! //phase.monad] + [[@var varT] (//type.check check.var) + [:inferred: analysis] (//type.inferring + (do ! + [_ (//type.inference (Tuple type/0 type/1 varT))] + (/.product ..analysis archive.empty + (list term/0 term/1 term/2 term/2 term/2)))) + :inferred: (//type.check (check.clean (list @var) :inferred:))] + (in (case analysis + (pattern (//analysis.tuple (list analysis/0 analysis/1 (//analysis.tuple (list analysis/2 analysis/3 analysis/4))))) + (and (type#= (Tuple type/0 type/1 type/2 type/2 type/2) + :inferred:) + (..analysed? term/0 analysis/0) + (..analysed? term/1 analysis/1) + (..analysed? term/2 analysis/2) + (..analysed? term/2 analysis/3) + (..analysed? term/2 analysis/4)) + + _ + false))) + (//module.with 0 module) + (//phase#each product.right) + (//phase.result state) + (try.else false)) + (|> (do [! //phase.monad] + [analysis (|> (list term/0 term/1 (code.tuple (list term/2 term/2 term/2))) + (/.product ..analysis archive.empty) + (//type.expecting (Tuple type/0 type/1 type/2 type/2 type/2)))] + (in (case analysis + (pattern (//analysis.tuple (list analysis/0 analysis/1 (//analysis.tuple (list analysis/2 analysis/3 analysis/4))))) + (and (..analysed? term/0 analysis/0) + (..analysed? term/1 analysis/1) + (..analysed? term/2 analysis/2) + (..analysed? term/2 analysis/3) + (..analysed? term/2 analysis/4)) + + _ + false))) + (//module.with 0 module) + (//phase#each product.right) + (//phase.result state) + (try.else false))))) + (_.for [/.cannot_analyse_tuple] + (_.cover [/.invalid_tuple_type] + (let [failure? (is (All (_ a) (-> (Exception a) (//analysis.Operation Any) Bit)) + (function (_ exception operation) + (let [it (//phase.result state operation)] + (and (..failure? /.cannot_analyse_tuple it) + (..failure? exception it)))))] + (and (|> expected + (/.product ..analysis archive.empty) + (//type.expecting (|> types/*,terms/* + list.head + (maybe#each product.left) + (maybe.else .Any))) + (failure? /.invalid_tuple_type)) + (|> (do //phase.monad + [[@var varT] (//type.check check.var)] + (|> expected + (/.product ..analysis archive.empty) + (//type.expecting (type (varT type/0))))) + (failure? /.invalid_tuple_type)))))) + ))) (def: test|record (do [! random.monad] @@ -470,163 +470,163 @@ _ slots/0)]] - ($_ _.and - (_.cover [/.normal] - (let [normal? (is (-> (List [Symbol Code]) (List Code) Bit) - (function (_ expected input) - (|> (do //phase.monad - [_ (//module.declare_labels true slots/0 false :record:)] - (/.normal false input)) - (//module.with 0 module) - (//phase#each product.right) - (//phase.result state) - (pipe.case - {try.#Success {.#Some actual}} - (let [(open "list#[0]") (list.equivalence (product.equivalence symbol.equivalence code.equivalence))] - (list#= expected (list.reversed actual))) - - _ - false))))] - (and (normal? (list) (list)) - (normal? expected_record global_record) - (normal? expected_record local_record) - (|> (/.normal false tuple) - (//phase.result state) - (pipe.case - {try.#Success {.#None}} - true - - _ - false))))) - (_.cover [/.order] - (let [local_record (list.zipped_2 (list#each (|>> [""]) slots/0) tuple) - global_record (list.zipped_2 (list#each (|>> [module]) slots/0) tuple) - ordered? (is (-> Bit (List [Symbol Code]) Bit) - (function (_ pattern_matching? input) + (all _.and + (_.cover [/.normal] + (let [normal? (is (-> (List [Symbol Code]) (List Code) Bit) + (function (_ expected input) (|> (do //phase.monad [_ (//module.declare_labels true slots/0 false :record:)] - (/.order pattern_matching? input)) - //scope.with + (/.normal false input)) (//module.with 0 module) - (//phase#each (|>> product.right product.right)) + (//phase#each product.right) (//phase.result state) (pipe.case - {try.#Success {.#Some [actual_arity actual_tuple actual_type]}} - (and (n.= arity actual_arity) - (# code.equivalence = (code.tuple tuple) (code.tuple actual_tuple)) - (type#= :record: actual_type)) - + {try.#Success {.#Some actual}} + (let [(open "list#[0]") (list.equivalence (product.equivalence symbol.equivalence code.equivalence))] + (list#= expected (list.reversed actual))) + _ - false)))) - unit? (is (-> Bit Bit) - (function (_ pattern_matching?) - (|> (/.order false (list)) - (//phase.result state) - (pipe.case - (pattern {try.#Success {.#Some [0 (list) actual_type]}}) - (same? .Any actual_type) - - _ - false))))] - (and (ordered? false global_record) - (ordered? false (list.reversed global_record)) - (ordered? false local_record) - (ordered? false (list.reversed local_record)) - - (ordered? true global_record) - (ordered? true (list.reversed global_record)) - (not (ordered? true local_record)) - (not (ordered? true (list.reversed local_record))) - - (unit? false) - (unit? true) - - ... TODO: Test what happens when slots are shadowed by local bindings. - ))) - (_.cover [/.cannot_repeat_slot] - (let [repeated? (is (-> Bit Bit) - (function (_ pattern_matching?) - (|> (do //phase.monad - [_ (//module.declare_labels true slots/0 false :record:)] - (/.order pattern_matching? (list.repeated arity [[module head_slot/0] head_term/0]))) - (//module.with 0 module) - (//phase#each product.right) - (//phase.result state) - (..failure? /.cannot_repeat_slot))))] - (and (repeated? false) - (repeated? true)))) - (_.cover [/.record_size_mismatch] - (let [local_record (list.zipped_2 (list#each (|>> [""]) slots/0) tuple) - global_record (list.zipped_2 (list#each (|>> [module]) slots/0) tuple) - mismatched? (is (-> Bit (List [Symbol Code]) Bit) - (function (_ pattern_matching? input) - (|> (do //phase.monad - [_ (//module.declare_labels true slots/0 false :record:)] - (/.order pattern_matching? input)) - //scope.with - (//module.with 0 module) - (//phase.result state) - (..failure? /.record_size_mismatch))))] - (and (mismatched? false (list.first slice local_record)) - (mismatched? false (list#composite local_record (list.first slice local_record))) - - (mismatched? false (list.first slice global_record)) - (mismatched? true (list.first slice global_record)) - (mismatched? false (list#composite global_record (list.first slice global_record))) - (mismatched? true (list#composite global_record (list.first slice global_record)))))) - (_.cover [/.slot_does_not_belong_to_record] - (let [local_record (list.zipped_2 (list#each (|>> [""]) slots/01) tuple) - global_record (list.zipped_2 (list#each (|>> [module]) slots/01) tuple) - mismatched? (is (-> Bit (List [Symbol Code]) Bit) - (function (_ pattern_matching? input) - (|> (do //phase.monad - [_ (//module.declare_labels true slots/0 false :record:) - _ (//module.declare_labels true slots/1 false :record:)] - (/.order pattern_matching? input)) - //scope.with - (//module.with 0 module) - (//phase.result state) - (..failure? /.slot_does_not_belong_to_record))))] - (and (mismatched? false local_record) - - (mismatched? false global_record) - (mismatched? true global_record)))) - (_.cover [/.record] - (let [record? (is (-> Type (List Text) (List Code) Code Bit) - (function (_ type slots tuple expected) - (|> (do //phase.monad - [_ (//module.declare_labels true slots false type)] - (/.record ..analysis archive.empty tuple)) - (//type.expecting type) - //scope.with - (//module.with 0 module) - (//phase#each (|>> product.right product.right)) - (//phase.result state) - (try#each (analysed? expected)) - (try.else false)))) - inferred? (is (-> (List Code) Bit) - (function (_ record) + false))))] + (and (normal? (list) (list)) + (normal? expected_record global_record) + (normal? expected_record local_record) + (|> (/.normal false tuple) + (//phase.result state) + (pipe.case + {try.#Success {.#None}} + true + + _ + false))))) + (_.cover [/.order] + (let [local_record (list.zipped_2 (list#each (|>> [""]) slots/0) tuple) + global_record (list.zipped_2 (list#each (|>> [module]) slots/0) tuple) + ordered? (is (-> Bit (List [Symbol Code]) Bit) + (function (_ pattern_matching? input) (|> (do //phase.monad [_ (//module.declare_labels true slots/0 false :record:)] - (//type.inferring - (/.record ..analysis archive.empty record))) + (/.order pattern_matching? input)) //scope.with (//module.with 0 module) (//phase#each (|>> product.right product.right)) (//phase.result state) - (try#each (function (_ [actual_type actual_term]) - (and (same? :record: actual_type) - (analysed? (code.tuple tuple) actual_term)))) - (try.else false))))] - (and (record? {.#Named name .Any} (list) (list) (' [])) - (record? {.#Named name type/0} (list) (list term/0) term/0) - (record? {.#Named name type/0} (list slot/0) (list term/0) term/0) - (record? :record: slots/0 tuple (code.tuple tuple)) - (record? :record: slots/0 local_record (code.tuple tuple)) - (record? :record: slots/0 global_record (code.tuple tuple)) - (inferred? local_record) - (inferred? global_record)))) - ))) + (pipe.case + {try.#Success {.#Some [actual_arity actual_tuple actual_type]}} + (and (n.= arity actual_arity) + (# code.equivalence = (code.tuple tuple) (code.tuple actual_tuple)) + (type#= :record: actual_type)) + + _ + false)))) + unit? (is (-> Bit Bit) + (function (_ pattern_matching?) + (|> (/.order false (list)) + (//phase.result state) + (pipe.case + (pattern {try.#Success {.#Some [0 (list) actual_type]}}) + (same? .Any actual_type) + + _ + false))))] + (and (ordered? false global_record) + (ordered? false (list.reversed global_record)) + (ordered? false local_record) + (ordered? false (list.reversed local_record)) + + (ordered? true global_record) + (ordered? true (list.reversed global_record)) + (not (ordered? true local_record)) + (not (ordered? true (list.reversed local_record))) + + (unit? false) + (unit? true) + + ... TODO: Test what happens when slots are shadowed by local bindings. + ))) + (_.cover [/.cannot_repeat_slot] + (let [repeated? (is (-> Bit Bit) + (function (_ pattern_matching?) + (|> (do //phase.monad + [_ (//module.declare_labels true slots/0 false :record:)] + (/.order pattern_matching? (list.repeated arity [[module head_slot/0] head_term/0]))) + (//module.with 0 module) + (//phase#each product.right) + (//phase.result state) + (..failure? /.cannot_repeat_slot))))] + (and (repeated? false) + (repeated? true)))) + (_.cover [/.record_size_mismatch] + (let [local_record (list.zipped_2 (list#each (|>> [""]) slots/0) tuple) + global_record (list.zipped_2 (list#each (|>> [module]) slots/0) tuple) + mismatched? (is (-> Bit (List [Symbol Code]) Bit) + (function (_ pattern_matching? input) + (|> (do //phase.monad + [_ (//module.declare_labels true slots/0 false :record:)] + (/.order pattern_matching? input)) + //scope.with + (//module.with 0 module) + (//phase.result state) + (..failure? /.record_size_mismatch))))] + (and (mismatched? false (list.first slice local_record)) + (mismatched? false (list#composite local_record (list.first slice local_record))) + + (mismatched? false (list.first slice global_record)) + (mismatched? true (list.first slice global_record)) + (mismatched? false (list#composite global_record (list.first slice global_record))) + (mismatched? true (list#composite global_record (list.first slice global_record)))))) + (_.cover [/.slot_does_not_belong_to_record] + (let [local_record (list.zipped_2 (list#each (|>> [""]) slots/01) tuple) + global_record (list.zipped_2 (list#each (|>> [module]) slots/01) tuple) + mismatched? (is (-> Bit (List [Symbol Code]) Bit) + (function (_ pattern_matching? input) + (|> (do //phase.monad + [_ (//module.declare_labels true slots/0 false :record:) + _ (//module.declare_labels true slots/1 false :record:)] + (/.order pattern_matching? input)) + //scope.with + (//module.with 0 module) + (//phase.result state) + (..failure? /.slot_does_not_belong_to_record))))] + (and (mismatched? false local_record) + + (mismatched? false global_record) + (mismatched? true global_record)))) + (_.cover [/.record] + (let [record? (is (-> Type (List Text) (List Code) Code Bit) + (function (_ type slots tuple expected) + (|> (do //phase.monad + [_ (//module.declare_labels true slots false type)] + (/.record ..analysis archive.empty tuple)) + (//type.expecting type) + //scope.with + (//module.with 0 module) + (//phase#each (|>> product.right product.right)) + (//phase.result state) + (try#each (analysed? expected)) + (try.else false)))) + inferred? (is (-> (List Code) Bit) + (function (_ record) + (|> (do //phase.monad + [_ (//module.declare_labels true slots/0 false :record:)] + (//type.inferring + (/.record ..analysis archive.empty record))) + //scope.with + (//module.with 0 module) + (//phase#each (|>> product.right product.right)) + (//phase.result state) + (try#each (function (_ [actual_type actual_term]) + (and (same? :record: actual_type) + (analysed? (code.tuple tuple) actual_term)))) + (try.else false))))] + (and (record? {.#Named name .Any} (list) (list) (' [])) + (record? {.#Named name type/0} (list) (list term/0) term/0) + (record? {.#Named name type/0} (list slot/0) (list term/0) term/0) + (record? :record: slots/0 tuple (code.tuple tuple)) + (record? :record: slots/0 local_record (code.tuple tuple)) + (record? :record: slots/0 global_record (code.tuple tuple)) + (inferred? local_record) + (inferred? global_record)))) + ))) (def: .public test (<| (_.covering /._) @@ -640,20 +640,20 @@ [type/1 term/1] ..simple_parameter tag (# ! each (n.% arity) random.nat) .let [[lefts right?] (//complex.choice arity tag)]] - ($_ _.and - ..test|sum - ..test|variant - ..test|product - ..test|record - (_.cover [/.not_a_quantified_type] - (and (|> (/.sum ..analysis lefts right? archive.empty term/0) - (//type.expecting (type (type/0 type/1))) - (//phase.result state) - (..failure? /.not_a_quantified_type)) - (|> types/*,terms/* - (list#each product.right) - (/.product ..analysis archive.empty) - (//type.expecting (type (type/0 type/1))) - (//phase.result state) - (..failure? /.not_a_quantified_type)))) - )))) + (all _.and + ..test|sum + ..test|variant + ..test|product + ..test|record + (_.cover [/.not_a_quantified_type] + (and (|> (/.sum ..analysis lefts right? archive.empty term/0) + (//type.expecting (type (type/0 type/1))) + (//phase.result state) + (..failure? /.not_a_quantified_type)) + (|> types/*,terms/* + (list#each product.right) + (/.product ..analysis archive.empty) + (//type.expecting (type (type/0 type/1))) + (//phase.result state) + (..failure? /.not_a_quantified_type)))) + )))) 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 6cc3bce45..1e52a34bf 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 @@ -80,118 +80,118 @@ $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) - (function (_ function_type output_term ?) - (|> (do //phase.monad - [analysis (|> (/.function ..analysis function/0 argument/0 archive.empty - output_term) - (//type.expecting function_type))] - (in (case analysis - {//analysis.#Function it} - (? it) + (all _.and + (_.cover [/.function] + (let [function?' (is (-> Type Code (-> [(List Analysis) Analysis] Bit) Bit) + (function (_ function_type output_term ?) + (|> (do //phase.monad + [analysis (|> (/.function ..analysis function/0 argument/0 archive.empty + output_term) + (//type.expecting function_type))] + (in (case analysis + {//analysis.#Function it} + (? it) - _ - false))) - (//module.with 0 module/0) - (//phase#each product.right) - (//phase.result state) - (try.else false)))) - function? (is (-> Type Code Bit) - (function (_ function_type output_term) - (function?' function_type output_term (function.constant true)))) - inferring? (is (-> Type Code Bit) - (function (_ :expected: term) - (|> (do //phase.monad - [[:actual: analysis] (|> (/.function ..analysis function/0 argument/0 archive.empty - term) - //type.inferring)] - (in (case analysis - {//analysis.#Function [actual_env actual_body]} - (type#= :expected: :actual:) + _ + false))) + (//module.with 0 module/0) + (//phase#each product.right) + (//phase.result state) + (try.else false)))) + function? (is (-> Type Code Bit) + (function (_ function_type output_term) + (function?' function_type output_term (function.constant true)))) + inferring? (is (-> Type Code Bit) + (function (_ :expected: term) + (|> (do //phase.monad + [[:actual: analysis] (|> (/.function ..analysis function/0 argument/0 archive.empty + term) + //type.inferring)] + (in (case analysis + {//analysis.#Function [actual_env actual_body]} + (type#= :expected: :actual:) - _ - false))) - (//module.with 0 module/0) - (//phase#each product.right) - (//phase.result state) - (try.else false))))] - (and (function? (-> input/0 output/0) term/0) - (function? (-> input/0 input/0) $argument/0) + _ + false))) + (//module.with 0 module/0) + (//phase#each product.right) + (//phase.result state) + (try.else false))))] + (and (function? (-> input/0 output/0) term/0) + (function? (-> input/0 input/0) $argument/0) - (function? {.#Named name/0 (-> input/0 output/0)} term/0) - - (function? (All (_ a) (-> a a)) $argument/0) - (function? (Ex (_ a) (-> a a)) $argument/0) - (function? (Ex (_ a) (-> input/0 a)) term/0) - (function? (Ex (_ a) (-> a a)) term/0) - (function? (Rec self (-> input/0 self)) $function/0) + (function? {.#Named name/0 (-> input/0 output/0)} term/0) + + (function? (All (_ a) (-> a a)) $argument/0) + (function? (Ex (_ a) (-> a a)) $argument/0) + (function? (Ex (_ a) (-> input/0 a)) term/0) + (function? (Ex (_ a) (-> a a)) term/0) + (function? (Rec self (-> input/0 self)) $function/0) - (function? (type ((All (_ a) (-> a a)) output/0)) term/0) - (not (function? (type ((All (_ a) (-> a a)) output/1)) term/0)) + (function? (type ((All (_ a) (-> a a)) output/0)) term/0) + (not (function? (type ((All (_ a) (-> a a)) output/1)) term/0)) - (function? (type ((Ex (_ a) (-> a a)) output/0)) term/0) - (not (function? (type ((Ex (_ a) (-> a a)) output/1)) term/0)) + (function? (type ((Ex (_ a) (-> a a)) output/0)) term/0) + (not (function? (type ((Ex (_ a) (-> a a)) output/1)) term/0)) - (function?' (-> input/0 input/1 input/0) (` ([(~ $function/1) (~ $argument/1)] (~ $argument/0))) - (function (_ [outer body]) - (and (list.empty? outer) - (case body - {//analysis.#Function [inner body]} - (n.= 1 (list.size inner)) + (function?' (-> input/0 input/1 input/0) (` ([(~ $function/1) (~ $argument/1)] (~ $argument/0))) + (function (_ [outer body]) + (and (list.empty? outer) + (case body + {//analysis.#Function [inner body]} + (n.= 1 (list.size inner)) - _ - false)))) - (function?' (-> input/0 input/1 input/1) (` ([(~ $function/1) (~ $argument/1)] (~ $argument/1))) - (function (_ [outer body]) - (and (list.empty? outer) - (case body - {//analysis.#Function [inner body]} - (n.= 0 (list.size inner)) + _ + false)))) + (function?' (-> input/0 input/1 input/1) (` ([(~ $function/1) (~ $argument/1)] (~ $argument/1))) + (function (_ [outer body]) + (and (list.empty? outer) + (case body + {//analysis.#Function [inner body]} + (n.= 0 (list.size inner)) - _ - false)))) + _ + false)))) - (|> (do //phase.monad - [[@var :var:] (//type.check check.var) - _ (//type.check (check.check :var: (-> input/0 output/0))) - analysis (|> (/.function ..analysis function/0 argument/0 archive.empty - term/0) - (//type.expecting :var:))] - (in (case analysis - {//analysis.#Function [actual_env actual_body]} - true + (|> (do //phase.monad + [[@var :var:] (//type.check check.var) + _ (//type.check (check.check :var: (-> input/0 output/0))) + analysis (|> (/.function ..analysis function/0 argument/0 archive.empty + term/0) + (//type.expecting :var:))] + (in (case analysis + {//analysis.#Function [actual_env actual_body]} + true - _ - false))) - (//module.with 0 module/0) - (//phase#each product.right) - (//phase.result state) - (try.else false)) - - (inferring? (All (_ a) (-> a output/0)) term/0) - (inferring? (All (_ a) (-> a a)) $argument/0) - (inferring? (All (_ @0) (-> @0 @0 (And .Bit @0))) - (` ([(~ $function/1) (~ $argument/1)] - [("lux is" (~ $argument/0) (~ $argument/1)) - (~ $argument/1)])))))) - (_.cover [/.cannot_analyse] - (|> (do //phase.monad - [analysis (|> (/.function ..analysis function/0 argument/0 archive.empty - term/1) - (//type.expecting (-> input/0 output/0)))] - (in (case analysis - {//analysis.#Function [actual_env actual_body]} - true + _ + false))) + (//module.with 0 module/0) + (//phase#each product.right) + (//phase.result state) + (try.else false)) + + (inferring? (All (_ a) (-> a output/0)) term/0) + (inferring? (All (_ a) (-> a a)) $argument/0) + (inferring? (All (_ @0) (-> @0 @0 (And .Bit @0))) + (` ([(~ $function/1) (~ $argument/1)] + [("lux is" (~ $argument/0) (~ $argument/1)) + (~ $argument/1)])))))) + (_.cover [/.cannot_analyse] + (|> (do //phase.monad + [analysis (|> (/.function ..analysis function/0 argument/0 archive.empty + term/1) + (//type.expecting (-> input/0 output/0)))] + (in (case analysis + {//analysis.#Function [actual_env actual_body]} + true - _ - false))) - (//module.with 0 module/0) - (//phase#each product.right) - (//phase.result state) - (exception.otherwise (text.contains? (the exception.#label /.cannot_analyse))))) - ))) + _ + false))) + (//module.with 0 module/0) + (//phase#each product.right) + (//phase.result state) + (exception.otherwise (text.contains? (the exception.#label /.cannot_analyse))))) + ))) (def: test|apply Test @@ -204,55 +204,55 @@ $//inference.simple_parameter) output/0 ($type.random 0) module/0 (random.ascii/lower 1)] - ($_ _.and - (_.cover [/.apply] - (let [reification? (is (-> Type (List Code) Type Bit) - (function (_ :abstraction: terms :expected:) - (|> (do //phase.monad - [[:actual: analysis] (|> (/.apply ..analysis terms - :abstraction: - (//analysis.unit) - archive.empty - (' [])) - //type.inferring)] - (in (and (check.subsumes? :expected: :actual:) - (case analysis - {//analysis.#Apply _} - true + (all _.and + (_.cover [/.apply] + (let [reification? (is (-> Type (List Code) Type Bit) + (function (_ :abstraction: terms :expected:) + (|> (do //phase.monad + [[:actual: analysis] (|> (/.apply ..analysis terms + :abstraction: + (//analysis.unit) + archive.empty + (' [])) + //type.inferring)] + (in (and (check.subsumes? :expected: :actual:) + (case analysis + {//analysis.#Apply _} + true - _ - false)))) - (//module.with 0 module/0) - (//phase#each product.right) - (//phase.result state) - (try.else false))))] - (and (reification? (-> input/0 input/1 output/0) (list term/0 term/1) output/0) - (reification? (-> input/0 input/1 output/0) (list term/0) (-> input/1 output/0)) - (reification? (All (_ a) (-> a a)) (list term/0) input/0) - (reification? (All (_ a) (-> a a a)) (list term/0) (-> input/0 input/0)) - (reification? (All (_ a) (-> input/0 a)) (list term/0) .Nothing) - (reification? (All (_ a b) (-> a b a)) (list term/0) (All (_ b) (-> b input/0))) - (reification? (Ex (_ a) (-> a input/0)) (list (` ("lux io error" ""))) input/0) - (reification? (Ex (_ a) (-> input/0 a)) (list term/0) .Any)))) - (_.cover [/.cannot_apply] - (|> (do //phase.monad - [_ (|> (/.apply ..analysis (list term/1 term/0) - (-> input/0 input/1 output/0) - (//analysis.unit) - archive.empty - (' [])) - (//type.expecting output/0))] - (in false)) - (//module.with 0 module/0) - (//phase#each product.right) - (//phase.result state) - (exception.otherwise (text.contains? (the exception.#label /.cannot_apply))))) - ))) + _ + false)))) + (//module.with 0 module/0) + (//phase#each product.right) + (//phase.result state) + (try.else false))))] + (and (reification? (-> input/0 input/1 output/0) (list term/0 term/1) output/0) + (reification? (-> input/0 input/1 output/0) (list term/0) (-> input/1 output/0)) + (reification? (All (_ a) (-> a a)) (list term/0) input/0) + (reification? (All (_ a) (-> a a a)) (list term/0) (-> input/0 input/0)) + (reification? (All (_ a) (-> input/0 a)) (list term/0) .Nothing) + (reification? (All (_ a b) (-> a b a)) (list term/0) (All (_ b) (-> b input/0))) + (reification? (Ex (_ a) (-> a input/0)) (list (` ("lux io error" ""))) input/0) + (reification? (Ex (_ a) (-> input/0 a)) (list term/0) .Any)))) + (_.cover [/.cannot_apply] + (|> (do //phase.monad + [_ (|> (/.apply ..analysis (list term/1 term/0) + (-> input/0 input/1 output/0) + (//analysis.unit) + archive.empty + (' [])) + (//type.expecting output/0))] + (in false)) + (//module.with 0 module/0) + (//phase#each product.right) + (//phase.result state) + (exception.otherwise (text.contains? (the exception.#label /.cannot_apply))))) + ))) (def: .public test Test (<| (_.covering /._) - ($_ _.and - ..test|function - ..test|apply - ))) + (all _.and + ..test|function + ..test|apply + ))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/reference.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/reference.lux index 8240bcddc..f67b2431d 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/reference.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/reference.lux @@ -42,182 +42,182 @@ import (random.ascii/lower 3) expected_label (random.ascii/lower 4) record? random.bit] - ($_ _.and - (_.cover [/.reference] - (let [can_find_local_variable! - (|> (/.reference ["" expected_name]) - (//scope.with_local [expected_name expected_type]) - //type.inferring - //scope.with - (//module.with 0 expected_module) - (//phase#each product.right) - (//phase.result state) - (try#each (|>> product.right - (pipe.case - (pattern [actual_type (//analysis.local 0)]) - (type#= expected_type actual_type) + (all _.and + (_.cover [/.reference] + (let [can_find_local_variable! + (|> (/.reference ["" expected_name]) + (//scope.with_local [expected_name expected_type]) + //type.inferring + //scope.with + (//module.with 0 expected_module) + (//phase#each product.right) + (//phase.result state) + (try#each (|>> product.right + (pipe.case + (pattern [actual_type (//analysis.local 0)]) + (type#= expected_type actual_type) - _ - false))) - (try.else false)) + _ + false))) + (try.else false)) - can_find_foreign_variable! - (|> (/.reference ["" expected_name]) - //type.inferring - //scope.with - (//scope.with_local [expected_name expected_type]) - //scope.with - (//module.with 0 expected_module) - (//phase#each product.right) - (//phase.result state) - (try#each (|>> product.right - product.right - (pipe.case - (pattern [actual_type (//analysis.foreign 0)]) - (type#= expected_type actual_type) + can_find_foreign_variable! + (|> (/.reference ["" expected_name]) + //type.inferring + //scope.with + (//scope.with_local [expected_name expected_type]) + //scope.with + (//module.with 0 expected_module) + (//phase#each product.right) + (//phase.result state) + (try#each (|>> product.right + product.right + (pipe.case + (pattern [actual_type (//analysis.foreign 0)]) + (type#= expected_type actual_type) - _ - false))) - (try.else false)) + _ + false))) + (try.else false)) - can_find_local_definition! - (|> (do //phase.monad - [_ (//module.define expected_name {.#Definition [#0 expected_type []]})] - (/.reference ["" expected_name])) - //type.inferring - (//module.with 0 expected_module) - (//phase.result state) - (try#each (|>> product.right - (pipe.case - (pattern [actual_type (//analysis.constant [actual_module actual_name])]) - (and (type#= expected_type actual_type) - (same? expected_module actual_module) - (same? expected_name actual_name)) + can_find_local_definition! + (|> (do //phase.monad + [_ (//module.define expected_name {.#Definition [#0 expected_type []]})] + (/.reference ["" expected_name])) + //type.inferring + (//module.with 0 expected_module) + (//phase.result state) + (try#each (|>> product.right + (pipe.case + (pattern [actual_type (//analysis.constant [actual_module actual_name])]) + (and (type#= expected_type actual_type) + (same? expected_module actual_module) + (same? expected_name actual_name)) - _ - false))) - (try.else false)) + _ + false))) + (try.else false)) - can_find_foreign_definition! - (|> (do //phase.monad - [_ (//module.with 0 import - (//module.define expected_name {.#Definition [#1 expected_type []]})) - _ (//module.import import)] - (/.reference [import expected_name])) - //type.inferring - (//module.with 0 expected_module) - (//phase.result state) - (try#each (|>> product.right - (pipe.case - (pattern [actual_type (//analysis.constant [actual_module actual_name])]) - (and (type#= expected_type actual_type) - (same? import actual_module) - (same? expected_name actual_name)) + can_find_foreign_definition! + (|> (do //phase.monad + [_ (//module.with 0 import + (//module.define expected_name {.#Definition [#1 expected_type []]})) + _ (//module.import import)] + (/.reference [import expected_name])) + //type.inferring + (//module.with 0 expected_module) + (//phase.result state) + (try#each (|>> product.right + (pipe.case + (pattern [actual_type (//analysis.constant [actual_module actual_name])]) + (and (type#= expected_type actual_type) + (same? import actual_module) + (same? expected_name actual_name)) - _ - false))) - (try.else false)) + _ + false))) + (try.else false)) - can_find_alias! - (|> (do //phase.monad - [_ (//module.with 0 import - (//module.define expected_name {.#Definition [#1 expected_type []]})) - _ (//module.import import) - _ (//module.define expected_name {.#Alias [import expected_name]})] - (/.reference [expected_module expected_name])) - //type.inferring - (//module.with 0 expected_module) - (//phase.result state) - (try#each (|>> product.right - (pipe.case - (pattern [actual_type (//analysis.constant [actual_module actual_name])]) - (and (type#= expected_type actual_type) - (same? import actual_module) - (same? expected_name actual_name)) + can_find_alias! + (|> (do //phase.monad + [_ (//module.with 0 import + (//module.define expected_name {.#Definition [#1 expected_type []]})) + _ (//module.import import) + _ (//module.define expected_name {.#Alias [import expected_name]})] + (/.reference [expected_module expected_name])) + //type.inferring + (//module.with 0 expected_module) + (//phase.result state) + (try#each (|>> product.right + (pipe.case + (pattern [actual_type (//analysis.constant [actual_module actual_name])]) + (and (type#= expected_type actual_type) + (same? import actual_module) + (same? expected_name actual_name)) - _ - false))) - (try.else false)) + _ + false))) + (try.else false)) - can_find_type! - (|> (do //phase.monad - [_ (//module.define expected_name {.#Type [#0 expected_type - (if record? - {.#Right [expected_label (list)]} - {.#Left [expected_label (list)]})]})] - (/.reference [expected_module expected_name])) - //type.inferring - (//module.with 0 expected_module) - (//phase.result state) - (try#each (|>> product.right - (pipe.case - (pattern [actual_type (//analysis.constant [actual_module actual_name])]) - (and (type#= .Type actual_type) - (same? expected_module actual_module) - (same? expected_name actual_name)) + can_find_type! + (|> (do //phase.monad + [_ (//module.define expected_name {.#Type [#0 expected_type + (if record? + {.#Right [expected_label (list)]} + {.#Left [expected_label (list)]})]})] + (/.reference [expected_module expected_name])) + //type.inferring + (//module.with 0 expected_module) + (//phase.result state) + (try#each (|>> product.right + (pipe.case + (pattern [actual_type (//analysis.constant [actual_module actual_name])]) + (and (type#= .Type actual_type) + (same? expected_module actual_module) + (same? expected_name actual_name)) - _ - false))) - (try.else false))] - (and can_find_local_variable! - can_find_foreign_variable! - - can_find_local_definition! - can_find_foreign_definition! + _ + false))) + (try.else false))] + (and can_find_local_variable! + can_find_foreign_variable! + + can_find_local_definition! + can_find_foreign_definition! - can_find_alias! - can_find_type!))) - (_.cover [/.foreign_module_has_not_been_imported] - (let [scenario (is (-> Type Global Bit) - (function (_ expected_type it) - (|> (do //phase.monad - [_ (//module.with 0 import - (//module.define expected_name it)) - _ (/.reference [import expected_name])] - (in false)) - (//type.expecting expected_type) - (//module.with 0 expected_module) - (//phase#each product.right) - (//phase.result state) - (exception.otherwise (text.contains? (the exception.#label /.foreign_module_has_not_been_imported))) - )))] - (and (scenario expected_type {.#Definition [#1 expected_type []]}) - (scenario .Type {.#Type [#1 expected_type - (if record? - {.#Right [expected_label (list)]} - {.#Left [expected_label (list)]})]})))) - (_.cover [/.definition_has_not_been_exported] - (let [scenario (is (-> Type Global Bit) - (function (_ expected_type it) - (|> (do //phase.monad - [_ (//module.with 0 import - (//module.define expected_name it)) - _ (/.reference [import expected_name])] - (in false)) - (//type.expecting expected_type) - (//module.with 0 expected_module) - (//phase#each product.right) - (//phase.result state) - (exception.otherwise (text.contains? (the exception.#label /.definition_has_not_been_exported))) - )))] - (and (scenario expected_type {.#Definition [#0 expected_type []]}) - (scenario .Type {.#Type [#0 expected_type - (if record? - {.#Right [expected_label (list)]} - {.#Left [expected_label (list)]})]})))) - (_.cover [/.labels_are_not_definitions] - (let [scenario (is (-> Type Global Bit) - (function (_ expected_type it) - (|> (do //phase.monad - [_ (//module.with 0 import - (//module.define expected_label it)) - _ (/.reference [import expected_label])] - (in false)) - (//type.expecting expected_type) - (//module.with 0 expected_module) - (//phase#each product.right) - (//phase.result state) - (exception.otherwise (text.contains? (the exception.#label /.labels_are_not_definitions))))))] - (and (scenario expected_type {.#Tag [#1 expected_type (list) 0]}) - (scenario expected_type {.#Slot [#1 expected_type (list) 0]})))) - )))) + can_find_alias! + can_find_type!))) + (_.cover [/.foreign_module_has_not_been_imported] + (let [scenario (is (-> Type Global Bit) + (function (_ expected_type it) + (|> (do //phase.monad + [_ (//module.with 0 import + (//module.define expected_name it)) + _ (/.reference [import expected_name])] + (in false)) + (//type.expecting expected_type) + (//module.with 0 expected_module) + (//phase#each product.right) + (//phase.result state) + (exception.otherwise (text.contains? (the exception.#label /.foreign_module_has_not_been_imported))) + )))] + (and (scenario expected_type {.#Definition [#1 expected_type []]}) + (scenario .Type {.#Type [#1 expected_type + (if record? + {.#Right [expected_label (list)]} + {.#Left [expected_label (list)]})]})))) + (_.cover [/.definition_has_not_been_exported] + (let [scenario (is (-> Type Global Bit) + (function (_ expected_type it) + (|> (do //phase.monad + [_ (//module.with 0 import + (//module.define expected_name it)) + _ (/.reference [import expected_name])] + (in false)) + (//type.expecting expected_type) + (//module.with 0 expected_module) + (//phase#each product.right) + (//phase.result state) + (exception.otherwise (text.contains? (the exception.#label /.definition_has_not_been_exported))) + )))] + (and (scenario expected_type {.#Definition [#0 expected_type []]}) + (scenario .Type {.#Type [#0 expected_type + (if record? + {.#Right [expected_label (list)]} + {.#Left [expected_label (list)]})]})))) + (_.cover [/.labels_are_not_definitions] + (let [scenario (is (-> Type Global Bit) + (function (_ expected_type it) + (|> (do //phase.monad + [_ (//module.with 0 import + (//module.define expected_label it)) + _ (/.reference [import expected_label])] + (in false)) + (//type.expecting expected_type) + (//module.with 0 expected_module) + (//phase#each product.right) + (//phase.result state) + (exception.otherwise (text.contains? (the exception.#label /.labels_are_not_definitions))))))] + (and (scenario expected_type {.#Tag [#1 expected_type (list) 0]}) + (scenario expected_type {.#Slot [#1 expected_type (list) 0]})))) + )))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/simple.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/simple.lux index 5827be799..4680a6e00 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/simple.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/simple.lux @@ -84,22 +84,22 @@ module (random.ascii/lower 2) configuration ($configuration.random 5) .let [state (/analysis.state (/analysis.info version host configuration))]] - (`` ($_ _.and - (_.cover [/.unit] - (..analysis state module .Any /.unit - (|>> (pipe.case (pattern (/analysis.unit)) true _ false)))) - (~~ (template [<analysis> <type> <random> <tag>] - [(do ! - [sample <random>] - (_.cover [<analysis>] - (..analysis state module <type> (<analysis> sample) - ((..analysis? <type> <tag>) sample))))] + (`` (all _.and + (_.cover [/.unit] + (..analysis state module .Any /.unit + (|>> (pipe.case (pattern (/analysis.unit)) true _ false)))) + (~~ (template [<analysis> <type> <random> <tag>] + [(do ! + [sample <random>] + (_.cover [<analysis>] + (..analysis state module <type> (<analysis> sample) + ((..analysis? <type> <tag>) sample))))] - [/.bit .Bit random.bit /analysis.bit] - [/.nat .Nat random.nat /analysis.nat] - [/.int .Int random.int /analysis.int] - [/.rev .Rev random.rev /analysis.rev] - [/.frac .Frac random.frac /analysis.frac] - [/.text .Text (random.unicode 1) /analysis.text] - )) - ))))) + [/.bit .Bit random.bit /analysis.bit] + [/.nat .Nat random.nat /analysis.nat] + [/.int .Int random.int /analysis.int] + [/.rev .Rev random.rev /analysis.rev] + [/.frac .Frac random.frac /analysis.frac] + [/.text .Text (random.unicode 1) /analysis.text] + )) + ))))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/extension.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/extension.lux index 307816a02..c76f452ed 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/extension.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/extension.lux @@ -32,10 +32,10 @@ (def: .public random (Random (/.Extension Nat)) - ($_ random.and - (random.ascii/lower 5) - (random.list 2 random.nat) - )) + (all random.and + (random.ascii/lower 5) + (random.list 2 random.nat) + )) (def: test|state Test @@ -43,55 +43,55 @@ [state random.int dummy (random.only (|>> (i.= state) not) random.int)] - ($_ _.and - (_.cover [/.read] - (|> (is (/.Operation Int Nat Nat Text) - (/.read %.int)) - (# phase.functor each (text#= (%.int state))) - (phase.result [/.#bundle /.empty - /.#state state]) - (try.else false))) - (_.cover [/.update] - (|> (is (/.Operation Int Nat Nat Text) - (do phase.monad - [_ (/.update ++)] - (/.read %.int))) - (# phase.functor each (text#= (%.int (++ state)))) - (phase.result [/.#bundle /.empty - /.#state state]) - (try.else false))) - (_.cover [/.temporary] - (|> (is (/.Operation Int Nat Nat Text) - (do phase.monad - [|state'| (/.temporary ++ (/.read %.int)) - |state| (/.read %.int)] - (in (format |state'| " " |state|)))) - (# phase.functor each (text#= (format (%.int (++ state)) " " (%.int state)))) - (phase.result [/.#bundle /.empty - /.#state state]) - (try.else false))) - (_.cover [/.with_state] - (|> (is (/.Operation Int Nat Nat Text) - (/.with_state state - (/.read %.int))) - (# phase.functor each (text#= (%.int state))) - (phase.result [/.#bundle /.empty - /.#state dummy]) - (try.else false))) - (_.cover [/.localized] - (|> (is (/.Operation Int Nat Nat Text) - (do phase.monad - [|state| (/.localized %.int - (function (_ _ old) (++ old)) - (text.enclosed ["<" ">"]) - (/.read %.int)) - |state'| (/.read %.int)] - (in (format |state'| " " |state|)))) - (# phase.functor each (text#= (format (%.int (i.+ +2 state)) - " " (%.int (i.+ +1 state))))) - (phase.result [/.#bundle /.empty - /.#state state]) - (try.else false)))) + (all _.and + (_.cover [/.read] + (|> (is (/.Operation Int Nat Nat Text) + (/.read %.int)) + (# phase.functor each (text#= (%.int state))) + (phase.result [/.#bundle /.empty + /.#state state]) + (try.else false))) + (_.cover [/.update] + (|> (is (/.Operation Int Nat Nat Text) + (do phase.monad + [_ (/.update ++)] + (/.read %.int))) + (# phase.functor each (text#= (%.int (++ state)))) + (phase.result [/.#bundle /.empty + /.#state state]) + (try.else false))) + (_.cover [/.temporary] + (|> (is (/.Operation Int Nat Nat Text) + (do phase.monad + [|state'| (/.temporary ++ (/.read %.int)) + |state| (/.read %.int)] + (in (format |state'| " " |state|)))) + (# phase.functor each (text#= (format (%.int (++ state)) " " (%.int state)))) + (phase.result [/.#bundle /.empty + /.#state state]) + (try.else false))) + (_.cover [/.with_state] + (|> (is (/.Operation Int Nat Nat Text) + (/.with_state state + (/.read %.int))) + (# phase.functor each (text#= (%.int state))) + (phase.result [/.#bundle /.empty + /.#state dummy]) + (try.else false))) + (_.cover [/.localized] + (|> (is (/.Operation Int Nat Nat Text) + (do phase.monad + [|state| (/.localized %.int + (function (_ _ old) (++ old)) + (text.enclosed ["<" ">"]) + (/.read %.int)) + |state'| (/.read %.int)] + (in (format |state'| " " |state|)))) + (# phase.functor each (text#= (format (%.int (i.+ +2 state)) + " " (%.int (i.+ +1 state))))) + (phase.result [/.#bundle /.empty + /.#state state]) + (try.else false)))) )) (def: extender @@ -115,32 +115,32 @@ extension (random.ascii/lower 1) left random.nat right random.nat] - ($_ _.and - (_.cover [/.cannot_overwrite] - (|> (do phase.monad - [_ (/.install extender extension handler/0)] - (/.install extender extension handler/1)) - (phase.result [/.#bundle /.empty - /.#state state]) - (pipe.case - {try.#Failure error} - (exception.match? /.cannot_overwrite error) + (all _.and + (_.cover [/.cannot_overwrite] + (|> (do phase.monad + [_ (/.install extender extension handler/0)] + (/.install extender extension handler/1)) + (phase.result [/.#bundle /.empty + /.#state state]) + (pipe.case + {try.#Failure error} + (exception.match? /.cannot_overwrite error) - _ - false))) - (_.cover [/.unknown] - (|> (/.apply archive.empty (function (_ archive input) - (# phase.monad in (++ input))) - [extension (list left right)]) - (phase.result [/.#bundle /.empty - /.#state state]) - (pipe.case - {try.#Failure error} - (exception.match? /.unknown error) + _ + false))) + (_.cover [/.unknown] + (|> (/.apply archive.empty (function (_ archive input) + (# phase.monad in (++ input))) + [extension (list left right)]) + (phase.result [/.#bundle /.empty + /.#state state]) + (pipe.case + {try.#Failure error} + (exception.match? /.unknown error) - _ - false))) - ))) + _ + false))) + ))) (def: test|bundle Test @@ -153,77 +153,77 @@ extension (random.ascii/lower 1) left random.nat right random.nat] - ($_ _.and - (_.cover [/.empty] - (dictionary.empty? /.empty)) - (<| (_.for [/.Extender /.Handler]) - ($_ _.and - (_.cover [/.install /.apply] - (|> (do phase.monad - [_ (/.install extender extension handler/0)] - (/.apply archive.empty phase [extension (list left right)])) - (# phase.functor each (n.= (n.+ left right))) - (phase.result [/.#bundle /.empty - /.#state state]) - (try.else false))) - (_.cover [/.Phase] - (let [handler (is (/.Handler Int Nat Nat) - (function (_ @self phase archive inputs) - (let [! phase.monad] - (|> inputs - (monad.each ! (phase archive)) - (# ! each (list#mix n.+ 0))))))] + (all _.and + (_.cover [/.empty] + (dictionary.empty? /.empty)) + (<| (_.for [/.Extender /.Handler]) + (all _.and + (_.cover [/.install /.apply] (|> (do phase.monad - [_ (/.install extender extension handler)] + [_ (/.install extender extension handler/0)] (/.apply archive.empty phase [extension (list left right)])) - (# phase.functor each (n.= (n.+ (++ left) (++ right)))) + (# phase.functor each (n.= (n.+ left right))) (phase.result [/.#bundle /.empty /.#state state]) - (try.else false)))) - (_.cover [/.with] - (|> (do phase.monad - [_ (/.with extender (dictionary.of_list text.hash (list [extension handler/1])))] - (/.apply archive.empty (function (_ archive input) - (# phase.monad in (++ input))) - [extension (list left right)])) - (# phase.functor each (n.= (n.* left right))) - (phase.result [/.#bundle /.empty - /.#state state]) - (try.else false))) - (_.cover [/.incorrect_arity] - (let [handler (is (/.Handler Int Nat Nat) - (function (_ @self phase archive inputs) - (phase.except /.incorrect_arity [@self 2 (list.size inputs)])))] + (try.else false))) + (_.cover [/.Phase] + (let [handler (is (/.Handler Int Nat Nat) + (function (_ @self phase archive inputs) + (let [! phase.monad] + (|> inputs + (monad.each ! (phase archive)) + (# ! each (list#mix n.+ 0))))))] + (|> (do phase.monad + [_ (/.install extender extension handler)] + (/.apply archive.empty phase [extension (list left right)])) + (# phase.functor each (n.= (n.+ (++ left) (++ right)))) + (phase.result [/.#bundle /.empty + /.#state state]) + (try.else false)))) + (_.cover [/.with] (|> (do phase.monad - [_ (/.install extender extension handler)] - (/.apply archive.empty phase [extension (list)])) + [_ (/.with extender (dictionary.of_list text.hash (list [extension handler/1])))] + (/.apply archive.empty (function (_ archive input) + (# phase.monad in (++ input))) + [extension (list left right)])) + (# phase.functor each (n.= (n.* left right))) (phase.result [/.#bundle /.empty /.#state state]) - (pipe.case - {try.#Failure error} - (exception.match? /.incorrect_arity error) + (try.else false))) + (_.cover [/.incorrect_arity] + (let [handler (is (/.Handler Int Nat Nat) + (function (_ @self phase archive inputs) + (phase.except /.incorrect_arity [@self 2 (list.size inputs)])))] + (|> (do phase.monad + [_ (/.install extender extension handler)] + (/.apply archive.empty phase [extension (list)])) + (phase.result [/.#bundle /.empty + /.#state state]) + (pipe.case + {try.#Failure error} + (exception.match? /.incorrect_arity error) - _ - false)))) - (_.cover [/.invalid_syntax] - (let [handler (is (/.Handler Int Nat Nat) - (function (_ @self phase archive inputs) - (phase.except /.invalid_syntax [@self %.nat inputs])))] - (|> (do phase.monad - [_ (/.install extender extension handler)] - (/.apply archive.empty phase [extension (list left right)])) - (phase.result [/.#bundle /.empty - /.#state state]) - (pipe.case - {try.#Failure error} - (exception.match? /.invalid_syntax error) + _ + false)))) + (_.cover [/.invalid_syntax] + (let [handler (is (/.Handler Int Nat Nat) + (function (_ @self phase archive inputs) + (phase.except /.invalid_syntax [@self %.nat inputs])))] + (|> (do phase.monad + [_ (/.install extender extension handler)] + (/.apply archive.empty phase [extension (list left right)])) + (phase.result [/.#bundle /.empty + /.#state state]) + (pipe.case + {try.#Failure error} + (exception.match? /.invalid_syntax error) - _ - false)))) - (_.for [/.Name] - ..test|name) - )) - )))) + _ + false)))) + (_.for [/.Name] + ..test|name) + )) + )))) (def: .public test Test @@ -235,46 +235,46 @@ random.int) expected random.nat expected_error (random.ascii/lower 1)] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec (/.equivalence n.equivalence) ..random)) - (_.for [/.hash] - ($hash.spec (/.hash n.hash) ..random)) - - (<| (_.for [/.Operation]) - ($_ _.and - (_.cover [/.lifted] - (and (|> (is (/.Operation Int Nat Nat Nat) - (/.lifted (do phase.monad - [] - (in expected)))) - (# phase.functor each (same? expected)) - (phase.result [/.#bundle /.empty - /.#state state]) - (try.else false)) - (|> (is (/.Operation Int Nat Nat Nat) - (/.lifted (phase.lifted {try.#Failure expected_error}))) - (phase.result [/.#bundle /.empty - /.#state state]) - (pipe.case - {try.#Failure actual_error} - (same? expected_error actual_error) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec (/.equivalence n.equivalence) ..random)) + (_.for [/.hash] + ($hash.spec (/.hash n.hash) ..random)) + + (<| (_.for [/.Operation]) + (all _.and + (_.cover [/.lifted] + (and (|> (is (/.Operation Int Nat Nat Nat) + (/.lifted (do phase.monad + [] + (in expected)))) + (# phase.functor each (same? expected)) + (phase.result [/.#bundle /.empty + /.#state state]) + (try.else false)) + (|> (is (/.Operation Int Nat Nat Nat) + (/.lifted (phase.lifted {try.#Failure expected_error}))) + (phase.result [/.#bundle /.empty + /.#state state]) + (pipe.case + {try.#Failure actual_error} + (same? expected_error actual_error) - _ - false)))) - (_.cover [/.up] - (|> (do phase.monad - [] - (in expected)) - (is (/.Operation Int Nat Nat Nat)) - /.up - (is (phase.Operation Int Nat)) - (# phase.functor each (same? expected)) - (phase.result state) - (try.else false))) - )) - (_.for [/.State] - ..test|state) - (_.for [/.Bundle] - ..test|bundle) - )))) + _ + false)))) + (_.cover [/.up] + (|> (do phase.monad + [] + (in expected)) + (is (/.Operation Int Nat Nat Nat)) + /.up + (is (phase.Operation Int Nat)) + (# phase.functor each (same? expected)) + (phase.result state) + (try.else false))) + )) + (_.for [/.State] + ..test|state) + (_.for [/.Bundle] + ..test|bundle) + )))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux index 24a9fb366..cbcd636f4 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux @@ -61,16 +61,16 @@ [[primT primC] ..primitive [antiT antiC] (|> ..primitive (r.only (|>> product.left (type#= primT) not)))] - ($_ _.and - (_.test "Can test for reference equality." - (check_success+ "lux is" (list primC primC) Bit)) - (_.test "Reference equality must be done with elements of the same type." - (check_failure+ "lux is" (list primC antiC) Bit)) - (_.test "Can 'try' risky IO computations." - (check_success+ "lux try" - (list (` ("lux io error" "YOLO"))) - (type (Either Text primT)))) - ))) + (all _.and + (_.test "Can test for reference equality." + (check_success+ "lux is" (list primC primC) Bit)) + (_.test "Reference equality must be done with elements of the same type." + (check_failure+ "lux is" (list primC antiC) Bit)) + (_.test "Can 'try' risky IO computations." + (check_success+ "lux try" + (list (` ("lux io error" "YOLO"))) + (type (Either Text primT)))) + ))) (def: i64 Test @@ -78,46 +78,46 @@ [subjectC (|> r.nat (# ! each code.nat)) signedC (|> r.int (# ! each code.int)) paramC (|> r.nat (# ! each code.nat))] - ($_ _.and - (_.test "i64 'and'." - (check_success+ "lux i64 and" (list paramC subjectC) Nat)) - (_.test "i64 'or'." - (check_success+ "lux i64 or" (list paramC subjectC) Nat)) - (_.test "i64 'xor'." - (check_success+ "lux i64 xor" (list paramC subjectC) Nat)) - (_.test "i64 left-shift." - (check_success+ "lux i64 left-shift" (list paramC subjectC) Nat)) - (_.test "i64 logical-right-shift." - (check_success+ "lux i64 logical-right-shift" (list paramC subjectC) Nat)) - (_.test "i64 arithmetic-right-shift." - (check_success+ "lux i64 arithmetic-right-shift" (list paramC signedC) Int)) - (_.test "i64 equivalence." - (check_success+ "lux i64 =" (list paramC subjectC) Bit)) - (_.test "i64 addition." - (check_success+ "lux i64 +" (list paramC subjectC) Int)) - (_.test "i64 subtraction." - (check_success+ "lux i64 -" (list paramC subjectC) Int)) - ))) + (all _.and + (_.test "i64 'and'." + (check_success+ "lux i64 and" (list paramC subjectC) Nat)) + (_.test "i64 'or'." + (check_success+ "lux i64 or" (list paramC subjectC) Nat)) + (_.test "i64 'xor'." + (check_success+ "lux i64 xor" (list paramC subjectC) Nat)) + (_.test "i64 left-shift." + (check_success+ "lux i64 left-shift" (list paramC subjectC) Nat)) + (_.test "i64 logical-right-shift." + (check_success+ "lux i64 logical-right-shift" (list paramC subjectC) Nat)) + (_.test "i64 arithmetic-right-shift." + (check_success+ "lux i64 arithmetic-right-shift" (list paramC signedC) Int)) + (_.test "i64 equivalence." + (check_success+ "lux i64 =" (list paramC subjectC) Bit)) + (_.test "i64 addition." + (check_success+ "lux i64 +" (list paramC subjectC) Int)) + (_.test "i64 subtraction." + (check_success+ "lux i64 -" (list paramC subjectC) Int)) + ))) (def: int Test (do [! r.monad] [subjectC (|> r.int (# ! each code.int)) paramC (|> r.int (# ! each code.int))] - ($_ _.and - (_.test "Can multiply integers." - (check_success+ "lux i64 *" (list paramC subjectC) Int)) - (_.test "Can divide integers." - (check_success+ "lux i64 /" (list paramC subjectC) Int)) - (_.test "Can calculate remainder of integers." - (check_success+ "lux i64 %" (list paramC subjectC) Int)) - (_.test "Can compare integers." - (check_success+ "lux i64 <" (list paramC subjectC) Bit)) - (_.test "Can convert integer to text." - (check_success+ "lux i64 char" (list subjectC) Text)) - (_.test "Can convert integer to fraction." - (check_success+ "lux i64 f64" (list subjectC) Frac)) - ))) + (all _.and + (_.test "Can multiply integers." + (check_success+ "lux i64 *" (list paramC subjectC) Int)) + (_.test "Can divide integers." + (check_success+ "lux i64 /" (list paramC subjectC) Int)) + (_.test "Can calculate remainder of integers." + (check_success+ "lux i64 %" (list paramC subjectC) Int)) + (_.test "Can compare integers." + (check_success+ "lux i64 <" (list paramC subjectC) Bit)) + (_.test "Can convert integer to text." + (check_success+ "lux i64 char" (list subjectC) Text)) + (_.test "Can convert integer to fraction." + (check_success+ "lux i64 f64" (list subjectC) Frac)) + ))) (def: frac Test @@ -125,34 +125,34 @@ [subjectC (|> r.safe_frac (# ! each code.frac)) paramC (|> r.safe_frac (# ! each code.frac)) encodedC (|> r.safe_frac (# ! each (|>> %.frac code.text)))] - ($_ _.and - (_.test "Can add frac numbers." - (check_success+ "lux f64 +" (list paramC subjectC) Frac)) - (_.test "Can subtract frac numbers." - (check_success+ "lux f64 -" (list paramC subjectC) Frac)) - (_.test "Can multiply frac numbers." - (check_success+ "lux f64 *" (list paramC subjectC) Frac)) - (_.test "Can divide frac numbers." - (check_success+ "lux f64 /" (list paramC subjectC) Frac)) - (_.test "Can calculate remainder of frac numbers." - (check_success+ "lux f64 %" (list paramC subjectC) Frac)) - (_.test "Can test equivalence of frac numbers." - (check_success+ "lux f64 =" (list paramC subjectC) Bit)) - (_.test "Can compare frac numbers." - (check_success+ "lux f64 <" (list paramC subjectC) Bit)) - (_.test "Can obtain minimum frac number." - (check_success+ "lux f64 min" (list) Frac)) - (_.test "Can obtain maximum frac number." - (check_success+ "lux f64 max" (list) Frac)) - (_.test "Can obtain smallest frac number." - (check_success+ "lux f64 smallest" (list) Frac)) - (_.test "Can convert frac number to integer." - (check_success+ "lux f64 i64" (list subjectC) Int)) - (_.test "Can convert frac number to text." - (check_success+ "lux f64 encode" (list subjectC) Text)) - (_.test "Can convert text to frac number." - (check_success+ "lux f64 decode" (list encodedC) (type (Maybe Frac)))) - ))) + (all _.and + (_.test "Can add frac numbers." + (check_success+ "lux f64 +" (list paramC subjectC) Frac)) + (_.test "Can subtract frac numbers." + (check_success+ "lux f64 -" (list paramC subjectC) Frac)) + (_.test "Can multiply frac numbers." + (check_success+ "lux f64 *" (list paramC subjectC) Frac)) + (_.test "Can divide frac numbers." + (check_success+ "lux f64 /" (list paramC subjectC) Frac)) + (_.test "Can calculate remainder of frac numbers." + (check_success+ "lux f64 %" (list paramC subjectC) Frac)) + (_.test "Can test equivalence of frac numbers." + (check_success+ "lux f64 =" (list paramC subjectC) Bit)) + (_.test "Can compare frac numbers." + (check_success+ "lux f64 <" (list paramC subjectC) Bit)) + (_.test "Can obtain minimum frac number." + (check_success+ "lux f64 min" (list) Frac)) + (_.test "Can obtain maximum frac number." + (check_success+ "lux f64 max" (list) Frac)) + (_.test "Can obtain smallest frac number." + (check_success+ "lux f64 smallest" (list) Frac)) + (_.test "Can convert frac number to integer." + (check_success+ "lux f64 i64" (list subjectC) Int)) + (_.test "Can convert frac number to text." + (check_success+ "lux f64 encode" (list subjectC) Text)) + (_.test "Can convert text to frac number." + (check_success+ "lux f64 decode" (list encodedC) (type (Maybe Frac)))) + ))) (def: text Test @@ -162,45 +162,45 @@ replacementC (|> (r.unicode 5) (# ! each code.text)) fromC (|> r.nat (# ! each code.nat)) toC (|> r.nat (# ! each code.nat))] - ($_ _.and - (_.test "Can test text equivalence." - (check_success+ "lux text =" (list paramC subjectC) Bit)) - (_.test "Compare texts in lexicographical order." - (check_success+ "lux text <" (list paramC subjectC) Bit)) - (_.test "Can concatenate one text to another." - (check_success+ "lux text concat" (list subjectC paramC) Text)) - (_.test "Can find the index of a piece of text inside a larger one that (may) contain it." - (check_success+ "lux text index" (list fromC paramC subjectC) (type (Maybe Nat)))) - (_.test "Can query the size/length of a text." - (check_success+ "lux text size" (list subjectC) Nat)) - (_.test "Can obtain the character code of a text at a given index." - (check_success+ "lux text char" (list fromC subjectC) Nat)) - (_.test "Can clip a piece of text between 2 indices." - (check_success+ "lux text clip" (list fromC toC subjectC) Text)) - ))) + (all _.and + (_.test "Can test text equivalence." + (check_success+ "lux text =" (list paramC subjectC) Bit)) + (_.test "Compare texts in lexicographical order." + (check_success+ "lux text <" (list paramC subjectC) Bit)) + (_.test "Can concatenate one text to another." + (check_success+ "lux text concat" (list subjectC paramC) Text)) + (_.test "Can find the index of a piece of text inside a larger one that (may) contain it." + (check_success+ "lux text index" (list fromC paramC subjectC) (type (Maybe Nat)))) + (_.test "Can query the size/length of a text." + (check_success+ "lux text size" (list subjectC) Nat)) + (_.test "Can obtain the character code of a text at a given index." + (check_success+ "lux text char" (list fromC subjectC) Nat)) + (_.test "Can clip a piece of text between 2 indices." + (check_success+ "lux text clip" (list fromC toC subjectC) Text)) + ))) (def: io Test (do [! r.monad] [logC (|> (r.unicode 5) (# ! each code.text)) exitC (|> r.int (# ! each code.int))] - ($_ _.and - (_.test "Can log messages to standard output." - (check_success+ "lux io log" (list logC) Any)) - (_.test "Can throw a run-time error." - (check_success+ "lux io error" (list logC) Nothing)) - (_.test "Can query the current time (as milliseconds since epoch)." - (check_success+ "lux io current-time" (list) Int)) - ))) + (all _.and + (_.test "Can log messages to standard output." + (check_success+ "lux io log" (list logC) Any)) + (_.test "Can throw a run-time error." + (check_success+ "lux io error" (list logC) Nothing)) + (_.test "Can query the current time (as milliseconds since epoch)." + (check_success+ "lux io current-time" (list) Int)) + ))) (def: .public test Test (<| (_.context (symbol.module (symbol /._))) - ($_ _.and - ..lux - ..i64 - ..int - ..frac - ..text - ..io - ))) + (all _.and + ..lux + ..i64 + ..int + ..frac + ..text + ..io + ))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis.lux index 357172053..e64b9540a 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis.lux @@ -1,21 +1,21 @@ (.using - [lux "*" - ["_" test {"+" Test}]] - ["[0]" / "_" - ["[1][0]" primitive] - ["[1][0]" structure] - ["[1][0]" case] - ["[1][0]" function] - ["[1][0]" loop] - ["[1][0]" variable]]) + [lux "*" + ["_" test {"+" Test}]] + ["[0]" / "_" + ["[1][0]" primitive] + ["[1][0]" structure] + ["[1][0]" case] + ["[1][0]" function] + ["[1][0]" loop] + ["[1][0]" variable]]) (def: .public test Test - ($_ _.and - /primitive.test - /structure.test - /case.test - /function.test - /loop.test - /variable.test - )) + (all _.and + /primitive.test + /structure.test + /case.test + /function.test + /loop.test + /variable.test + )) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/case.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/case.lux index b65c3fa9d..4ea071954 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/case.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/case.lux @@ -201,12 +201,12 @@ (do [! random.monad] [[test/0 test/1 test/2 test/3 test/4] (random_five <hash> <random>) [body/0 body/1 body/2 body/3 body/4] (random_five <hash> <random>)] - (in [($_ {synthesis.#Alt} - {synthesis.#Seq (<path> test/0) {synthesis.#Then (<synthesis> body/0)}} - {synthesis.#Seq (<path> test/1) {synthesis.#Then (<synthesis> body/1)}} - {synthesis.#Seq (<path> test/2) {synthesis.#Then (<synthesis> body/2)}} - {synthesis.#Seq (<path> test/3) {synthesis.#Then (<synthesis> body/3)}} - {synthesis.#Seq (<path> test/4) {synthesis.#Then (<synthesis> body/4)}}) + (in [(all {synthesis.#Alt} + {synthesis.#Seq (<path> test/0) {synthesis.#Then (<synthesis> body/0)}} + {synthesis.#Seq (<path> test/1) {synthesis.#Then (<synthesis> body/1)}} + {synthesis.#Seq (<path> test/2) {synthesis.#Then (<synthesis> body/2)}} + {synthesis.#Seq (<path> test/3) {synthesis.#Then (<synthesis> body/3)}} + {synthesis.#Seq (<path> test/4) {synthesis.#Then (<synthesis> body/4)}}) [[analysis.#when (<pattern> test/0) analysis.#then (<analysis> body/0)] (list [analysis.#when (<pattern> test/1) analysis.#then (<analysis> body/1)] [analysis.#when (<pattern> test/2) analysis.#then (<analysis> body/2)] @@ -221,14 +221,14 @@ ) (def: random_simple - ($_ random.either - ..random_bit - ..random_nat - ..random_int - ..random_rev - ..random_frac - ..random_text - )) + (all random.either + ..random_bit + ..random_nat + ..random_int + ..random_rev + ..random_frac + ..random_text + )) (def: random_variant (Random [Path Match]) @@ -239,24 +239,24 @@ [body/0 body/1 body/2 body/3 body/4] (random_five frac.hash random.frac) .let [path (is (-> Nat Bit Text Frac Path) (function (_ lefts right? value body) - ($_ {synthesis.#Seq} - (synthesis.path/side (if right? - {.#Right lefts} - {.#Left lefts})) - (synthesis.path/text value) - {synthesis.#Then (synthesis.f64 body)}))) + (all {synthesis.#Seq} + (synthesis.path/side (if right? + {.#Right lefts} + {.#Left lefts})) + (synthesis.path/text value) + {synthesis.#Then (synthesis.f64 body)}))) branch (is (-> Nat Bit Text Frac Branch) (function (_ lefts right? value body) [analysis.#when (analysis.pattern/variant [analysis.#lefts lefts analysis.#right? right? analysis.#value (analysis.pattern/text value)]) analysis.#then (analysis.frac body)]))]] - (in [($_ {synthesis.#Alt} - (path lefts/0 false value/0 body/0) - (path lefts/1 false value/1 body/1) - (path lefts/2 false value/2 body/2) - (path lefts/3 false value/3 body/3) - (path lefts/4 last_is_right? value/4 body/4)) + (in [(all {synthesis.#Alt} + (path lefts/0 false value/0 body/0) + (path lefts/1 false value/1 body/1) + (path lefts/2 false value/2 body/2) + (path lefts/3 false value/3 body/3) + (path lefts/4 last_is_right? value/4 body/4)) [(branch lefts/0 false value/0 body/0) (list (branch lefts/1 false value/1 body/1) (branch lefts/2 false value/2 body/2) @@ -278,28 +278,28 @@ .let [path (is (-> Nat Bit Text Frac Path) (function (_ lefts right? value body) (if right? - ($_ {synthesis.#Seq} - (synthesis.path/member (if right? - {.#Right lefts} - {.#Left lefts})) - (synthesis.path/text value) - {synthesis.#Then (synthesis.f64 body)}) - ($_ {synthesis.#Seq} - (synthesis.path/member (if right? - {.#Right lefts} - {.#Left lefts})) - (synthesis.path/text value) - {synthesis.#Pop} - {synthesis.#Then (synthesis.f64 body)})))) + (all {synthesis.#Seq} + (synthesis.path/member (if right? + {.#Right lefts} + {.#Left lefts})) + (synthesis.path/text value) + {synthesis.#Then (synthesis.f64 body)}) + (all {synthesis.#Seq} + (synthesis.path/member (if right? + {.#Right lefts} + {.#Left lefts})) + (synthesis.path/text value) + {synthesis.#Pop} + {synthesis.#Then (synthesis.f64 body)})))) branch (is (-> Nat Bit Text Frac Branch) (function (_ lefts right? value body) [analysis.#when (if right? (analysis.pattern/tuple (list#composite (list.repeated (++ lefts) (analysis.pattern/unit)) (list (analysis.pattern/text value)))) - (analysis.pattern/tuple ($_ list#composite - (list.repeated lefts (analysis.pattern/unit)) - (list (analysis.pattern/text value) - (analysis.pattern/unit))))) + (analysis.pattern/tuple (all list#composite + (list.repeated lefts (analysis.pattern/unit)) + (list (analysis.pattern/text value) + (analysis.pattern/unit))))) analysis.#then (analysis.frac body)]))]] (in [(list#mix (function (_ left right) {synthesis.#Alt left right}) @@ -318,16 +318,16 @@ (list (branch (++ mid_size) true value/last body/last)))]]))) (def: random_complex - ($_ random.either - ..random_variant - ..random_tuple - )) + (all random.either + ..random_variant + ..random_tuple + )) (def: random_case - ($_ random.either - ..random_simple - ..random_complex - )) + (all random.either + ..random_simple + ..random_complex + )) (def: case_test Test @@ -349,10 +349,10 @@ Test (<| (_.covering /._) (_.for [/.synthesize]) - ($_ _.and - ..masking_test - ..let_test - ..if_test - ..get_test - ..case_test - ))) + (all _.and + ..masking_test + ..let_test + ..if_test + ..get_test + ..case_test + ))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/function.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/function.lux index 01ebdec3f..df05fcc1a 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/function.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/function.lux @@ -55,10 +55,10 @@ (list#mix (function (_ arity_1 body) (case arity_1 0 {analysis.#Function (list) body} - _ {analysis.#Function ($_ list#composite - (list#each (|>> {variable.#Foreign}) - (list.indices arity_1)) - (list {variable.#Local 1})) + _ {analysis.#Function (all list#composite + (list#each (|>> {variable.#Foreign}) + (list.indices arity_1)) + (list {variable.#Local 1})) body})) body (list.reversed (list.indices arity)))) @@ -142,9 +142,9 @@ (def: (random_structure random_value output?) (-> Scenario Scenario) - ($_ random.either - (..random_variant random_value output?) - (..random_tuple random_value output?))) + (all random.either + (..random_variant random_value output?) + (..random_tuple random_value output?))) (def: (random_variable arity output?) (-> Arity Scenario) @@ -187,32 +187,32 @@ (in [(and loop?_input loop?_output) (synthesis.branch/case [expected_input - ($_ synthesis.path/alt - (synthesis.path/then expected_output) - (synthesis.path/seq (synthesis.path/bit bit_test) - (synthesis.path/then expected_output)) - (synthesis.path/seq (synthesis.path/i64 (.i64 i64_test)) - (synthesis.path/then expected_output)) - (synthesis.path/seq (synthesis.path/f64 f64_test) - (synthesis.path/then expected_output)) - (synthesis.path/seq (synthesis.path/text text_test) - (synthesis.path/then expected_output)) - (synthesis.path/seq (synthesis.path/bind (++ arity)) - (synthesis.path/then expected_output)) - ($_ synthesis.path/seq - (synthesis.path/side side|member) - (synthesis.path/bind (++ arity)) - (synthesis.path/then expected_output)) - (if right? - ($_ synthesis.path/seq - (synthesis.path/member side|member) + (all synthesis.path/alt + (synthesis.path/then expected_output) + (synthesis.path/seq (synthesis.path/bit bit_test) + (synthesis.path/then expected_output)) + (synthesis.path/seq (synthesis.path/i64 (.i64 i64_test)) + (synthesis.path/then expected_output)) + (synthesis.path/seq (synthesis.path/f64 f64_test) + (synthesis.path/then expected_output)) + (synthesis.path/seq (synthesis.path/text text_test) + (synthesis.path/then expected_output)) + (synthesis.path/seq (synthesis.path/bind (++ arity)) + (synthesis.path/then expected_output)) + (all synthesis.path/seq + (synthesis.path/side side|member) (synthesis.path/bind (++ arity)) - (synthesis.path/then expected_output)) - ($_ synthesis.path/seq - (synthesis.path/member side|member) - (synthesis.path/bind (++ arity)) - synthesis.path/pop - (synthesis.path/then expected_output))))]) + (synthesis.path/then expected_output)) + (if right? + (all synthesis.path/seq + (synthesis.path/member side|member) + (synthesis.path/bind (++ arity)) + (synthesis.path/then expected_output)) + (all synthesis.path/seq + (synthesis.path/member side|member) + (synthesis.path/bind (++ arity)) + synthesis.path/pop + (synthesis.path/then expected_output))))]) {analysis.#Case actual_input [[analysis.#when (analysis.pattern/unit) analysis.#then actual_output] @@ -335,10 +335,10 @@ (def: (random_loop arity random_value output?) (-> Arity Scenario Scenario) (if output? - ($_ random.either - (..random_again arity random_value output?) - (..random_scope arity output?) - ) + (all random.either + (..random_again arity random_value output?) + (..random_scope arity output?) + ) (..random_scope arity output?))) (def: (random_abstraction' output?) @@ -346,10 +346,10 @@ (do [! random.monad] [[loop?_output expected_output actual_output] (..random_nat output?) arity (|> random.nat (# ! each (|>> (n.% 5) ++))) - .let [environment ($_ list#composite - (list#each (|>> {variable.#Foreign}) - (list.indices arity)) - (list {variable.#Local 1}))]] + .let [environment (all list#composite + (list#each (|>> {variable.#Foreign}) + (list.indices arity)) + (list {variable.#Local 1}))]] (in [true (synthesis.function/abstraction [synthesis.#environment environment @@ -380,18 +380,18 @@ (-> Scenario Scenario) (if output? (..random_apply random_value output?) - ($_ random.either - (..random_abstraction' output?) - (..random_apply random_value output?) - ))) + (all random.either + (..random_abstraction' output?) + (..random_apply random_value output?) + ))) (def: (random_control arity random_value output?) (-> Arity Scenario Scenario) - ($_ random.either - (..random_branch arity random_value output?) - (..random_loop arity random_value output?) - (..random_function random_value output?) - )) + (all random.either + (..random_branch arity random_value output?) + (..random_loop arity random_value output?) + (..random_function random_value output?) + )) (def: (random_extension random_value output?) (-> Scenario Scenario) @@ -411,12 +411,12 @@ (function (random_value output?) (random.rec (function (_ _) - ($_ random.either - (..random_primitive output?) - (..random_structure random_value output?) - (..random_reference arity output?) - (..random_control arity random_value output?) - (..random_extension random_value output?)))))) + (all random.either + (..random_primitive output?) + (..random_structure random_value output?) + (..random_reference arity output?) + (..random_control arity random_value output?) + (..random_extension random_value output?)))))) (def: random_abstraction (Random [Synthesis Analysis]) @@ -460,7 +460,7 @@ (def: .public test Test (<| (_.covering /._) - ($_ _.and - ..abstraction - ..application - ))) + (all _.and + ..abstraction + ..application + ))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/loop.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/loop.lux index 84c3873aa..7120348e1 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/loop.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/loop.lux @@ -28,20 +28,20 @@ (def: (primitive offset arity next) (Scenario Synthesis) - (`` ($_ random.either - (~~ (template [<synthesis> <random>] - [(do [! random.monad] - [example (# ! each (|>> <synthesis>) <random>)] - (in [next - [example - example]]))] + (`` (all random.either + (~~ (template [<synthesis> <random>] + [(do [! random.monad] + [example (# ! each (|>> <synthesis>) <random>)] + (in [next + [example + example]]))] - [//.bit random.bit] - [//.i64 (# ! each .i64 random.nat)] - [//.f64 random.frac] - [//.text (random.unicode 1)] - )) - ))) + [//.bit random.bit] + [//.i64 (# ! each .i64 random.nat)] + [//.f64 random.frac] + [//.text (random.unicode 1)] + )) + ))) (def: (constant offset arity next) (Scenario Constant) @@ -61,88 +61,88 @@ {variable.#Local register}]]))] (case offset 0 local - _ ($_ random.either - local - (do [! random.monad] - [foreign (# ! each (n.% offset) random.nat)] - (in [next - [{variable.#Local foreign} - {variable.#Foreign foreign}]])))))) + _ (all random.either + local + (do [! random.monad] + [foreign (# ! each (n.% offset) random.nat)] + (in [next + [{variable.#Local foreign} + {variable.#Foreign foreign}]])))))) (def: (reference offset arity next) (Scenario Synthesis) - (`` ($_ random.either - (~~ (template [<tag> <random>] - [(do [! random.monad] - [[next [exampleE exampleA]] (<random> offset arity next)] - (in [next - [(<tag> exampleE) - (<tag> exampleA)]]))] + (`` (all random.either + (~~ (template [<tag> <random>] + [(do [! random.monad] + [[next [exampleE exampleA]] (<random> offset arity next)] + (in [next + [(<tag> exampleE) + (<tag> exampleA)]]))] - [//.constant ..constant] - [//.variable ..variable] - ))))) + [//.constant ..constant] + [//.variable ..variable] + ))))) (def: (structure offset arity next) (Scenario Synthesis) - ($_ random.either - (do [! random.monad] - [lefts random.nat - right? random.bit - [next [valueE valueA]] (..reference offset arity next)] - (in [next - [(//.variant - [analysis.#lefts lefts - analysis.#right? right? - analysis.#value valueE]) - (//.variant - [analysis.#lefts lefts - analysis.#right? right? - analysis.#value valueA])]])) - (do [! random.monad] - [[next [leftE leftA]] (..reference offset arity next) - [next [rightE rightA]] (..reference offset arity next)] - (in [next - [(//.tuple (list leftE rightE)) - (//.tuple (list leftA rightA))]])) - )) + (all random.either + (do [! random.monad] + [lefts random.nat + right? random.bit + [next [valueE valueA]] (..reference offset arity next)] + (in [next + [(//.variant + [analysis.#lefts lefts + analysis.#right? right? + analysis.#value valueE]) + (//.variant + [analysis.#lefts lefts + analysis.#right? right? + analysis.#value valueA])]])) + (do [! random.monad] + [[next [leftE leftA]] (..reference offset arity next) + [next [rightE rightA]] (..reference offset arity next)] + (in [next + [(//.tuple (list leftE rightE)) + (//.tuple (list leftA rightA))]])) + )) (def: path (Scenario Path) (let [pattern (is (Scenario Path) (.function (again offset arity next) - (`` ($_ random.either - (random#in [next - [//.path/pop - //.path/pop]]) - (~~ (template [<path> <random>] - [(do [! random.monad] - [example (# ! each (|>> <path>) <random>)] - (in [next - [example - example]]))] + (`` (all random.either + (random#in [next + [//.path/pop + //.path/pop]]) + (~~ (template [<path> <random>] + [(do [! random.monad] + [example (# ! each (|>> <path>) <random>)] + (in [next + [example + example]]))] - [//.path/bit random.bit] - [//.path/i64 (# ! each .i64 random.nat)] - [//.path/f64 random.frac] - [//.path/text (random.unicode 1)] - )) - (~~ (template [<path>] - [(do [! random.monad] - [example (# ! each (|>> <path>) - (random.or random.nat - random.nat))] - (in [next - [example - example]]))] + [//.path/bit random.bit] + [//.path/i64 (# ! each .i64 random.nat)] + [//.path/f64 random.frac] + [//.path/text (random.unicode 1)] + )) + (~~ (template [<path>] + [(do [! random.monad] + [example (# ! each (|>> <path>) + (random.or random.nat + random.nat))] + (in [next + [example + example]]))] - [//.path/side] - [//.path/member] - )) - (random#in [(++ next) - [(//.path/bind (/.register_optimization offset next)) - (//.path/bind next)]]) - )))) + [//.path/side] + [//.path/member] + )) + (random#in [(++ next) + [(//.path/bind (/.register_optimization offset next)) + (//.path/bind next)]]) + )))) sequential (is (Scenario Path) (.function (again offset arity next) (do random.monad @@ -164,81 +164,81 @@ (let [random_member (is (Random Member) (random.or random.nat random.nat))] - ($_ random.either - ($_ random.either - (do [! random.monad] - [[next [inputE inputA]] (..reference offset arity next) - [next [bodyE bodyA]] (..reference offset arity next)] - (in [next - [(//.branch/let [inputE (/.register_optimization offset next) bodyE]) - (//.branch/let [inputA next bodyA])]])) - (do [! random.monad] - [[next [testE testA]] (..reference offset arity next) - [next [thenE thenA]] (..reference offset arity next) - [next [elseE elseA]] (..reference offset arity next)] - (in [next - [(//.branch/if [testE thenE elseE]) - (//.branch/if [testA thenA elseA])]]))) - ($_ random.either - (do [! random.monad] - [[next [recordE recordA]] (..reference offset arity next) - path_length (# ! each (|>> (n.% 5) ++) random.nat) - path (random.list path_length random_member)] - (in [next - [(//.branch/get [path recordE]) - (//.branch/get [path recordA])]])) - (do [! random.monad] - [[next [inputE inputA]] (..reference offset arity next) - [next [pathE pathA]] (..path offset arity next)] - (in [next - [(//.branch/case [inputE pathE]) - (//.branch/case [inputA pathA])]]))) - ))) + (all random.either + (all random.either + (do [! random.monad] + [[next [inputE inputA]] (..reference offset arity next) + [next [bodyE bodyA]] (..reference offset arity next)] + (in [next + [(//.branch/let [inputE (/.register_optimization offset next) bodyE]) + (//.branch/let [inputA next bodyA])]])) + (do [! random.monad] + [[next [testE testA]] (..reference offset arity next) + [next [thenE thenA]] (..reference offset arity next) + [next [elseE elseA]] (..reference offset arity next)] + (in [next + [(//.branch/if [testE thenE elseE]) + (//.branch/if [testA thenA elseA])]]))) + (all random.either + (do [! random.monad] + [[next [recordE recordA]] (..reference offset arity next) + path_length (# ! each (|>> (n.% 5) ++) random.nat) + path (random.list path_length random_member)] + (in [next + [(//.branch/get [path recordE]) + (//.branch/get [path recordA])]])) + (do [! random.monad] + [[next [inputE inputA]] (..reference offset arity next) + [next [pathE pathA]] (..path offset arity next)] + (in [next + [(//.branch/case [inputE pathE]) + (//.branch/case [inputA pathA])]]))) + ))) (def: (loop offset arity next) (Scenario Synthesis) - ($_ random.either - (do random.monad - [[next [firstE firstA]] (..reference offset arity next) - [next [secondE secondA]] (..reference offset arity next) - [next [iterationE iterationA]] (..reference offset arity next)] - (in [next - [(//.loop/scope - [//.#start (/.register_optimization offset next) - //.#inits (list firstE secondE) - //.#iteration iterationE]) - (//.loop/scope - [//.#start next - //.#inits (list firstA secondA) - //.#iteration iterationA])]])) - )) + (all random.either + (do random.monad + [[next [firstE firstA]] (..reference offset arity next) + [next [secondE secondA]] (..reference offset arity next) + [next [iterationE iterationA]] (..reference offset arity next)] + (in [next + [(//.loop/scope + [//.#start (/.register_optimization offset next) + //.#inits (list firstE secondE) + //.#iteration iterationE]) + (//.loop/scope + [//.#start next + //.#inits (list firstA secondA) + //.#iteration iterationA])]])) + )) (def: (function offset arity next) (Scenario Synthesis) - ($_ random.either - (do [! random.monad] - [[next [firstE firstA]] (..variable offset arity next) - [next [secondE secondA]] (..variable offset arity next) - arity (# ! each (n.max 1) random.nat) - [next [bodyE bodyA]] (..primitive 0 arity next)] - (in [next - [(//.function/abstraction - [//.#environment (list firstE secondE) - //.#arity arity - //.#body bodyE]) - (//.function/abstraction - [//.#environment (list firstA secondA) - //.#arity arity - //.#body bodyA])]])) - )) + (all random.either + (do [! random.monad] + [[next [firstE firstA]] (..variable offset arity next) + [next [secondE secondA]] (..variable offset arity next) + arity (# ! each (n.max 1) random.nat) + [next [bodyE bodyA]] (..primitive 0 arity next)] + (in [next + [(//.function/abstraction + [//.#environment (list firstE secondE) + //.#arity arity + //.#body bodyE]) + (//.function/abstraction + [//.#environment (list firstA secondA) + //.#arity arity + //.#body bodyA])]])) + )) (def: (control offset arity next) (Scenario Synthesis) - ($_ random.either - (..branch offset arity next) - (..loop offset arity next) - (..function offset arity next) - )) + (all random.either + (..branch offset arity next) + (..loop offset arity next) + (..function offset arity next) + )) (def: (extension offset arity next) (Scenario Synthesis) @@ -253,41 +253,41 @@ (def: (scenario offset arity next) (Scenario Synthesis) - ($_ random.either - (..primitive offset arity next) - (..structure offset arity next) - (..reference offset arity next) - (..control offset arity next) - (..extension offset arity next) - )) + (all random.either + (..primitive offset arity next) + (..structure offset arity next) + (..reference offset arity next) + (..control offset arity next) + (..extension offset arity next) + )) (def: .public test Test (<| (_.covering /._) - ($_ _.and - (do [! random.monad] - [expected_offset (# ! each (|>> (n.% 5) (n.+ 2)) random.nat) - arity (# ! each (|>> (n.% 5) ++) random.nat) - expected_inits (|> random.nat - (# ! each (|>> .i64 //.i64)) - (random.list arity)) - [_ [expected iteration]] (..scenario expected_offset arity 0)] - (_.cover [/.Transform /.optimization /.register_optimization] - (case (/.optimization true expected_offset expected_inits - [//.#environment (|> expected_offset - list.indices - (list#each (|>> {variable.#Local}))) - //.#arity arity - //.#body iteration]) - (pattern {.#Some (//.loop/scope [actual_offset actual_inits - actual])}) - (and (n.= expected_offset - actual_offset) - (# (list.equivalence //.equivalence) = - expected_inits - actual_inits) - (# //.equivalence = expected actual)) - - _ - false))) - ))) + (all _.and + (do [! random.monad] + [expected_offset (# ! each (|>> (n.% 5) (n.+ 2)) random.nat) + arity (# ! each (|>> (n.% 5) ++) random.nat) + expected_inits (|> random.nat + (# ! each (|>> .i64 //.i64)) + (random.list arity)) + [_ [expected iteration]] (..scenario expected_offset arity 0)] + (_.cover [/.Transform /.optimization /.register_optimization] + (case (/.optimization true expected_offset expected_inits + [//.#environment (|> expected_offset + list.indices + (list#each (|>> {variable.#Local}))) + //.#arity arity + //.#body iteration]) + (pattern {.#Some (//.loop/scope [actual_offset actual_inits + actual])}) + (and (n.= expected_offset + actual_offset) + (# (list.equivalence //.equivalence) = + expected_inits + actual_inits) + (# //.equivalence = expected actual)) + + _ + false))) + ))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/primitive.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/primitive.lux index 33f3378a1..b1b494810 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/primitive.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/primitive.lux @@ -32,14 +32,14 @@ (Random Analysis) (do r.monad [primitive (is (Random ////analysis.Primitive) - ($_ r.or - (in []) - r.bit - r.nat - r.int - r.rev - r.frac - (r.unicode 5)))] + (all r.or + (in []) + r.bit + r.nat + r.int + r.rev + r.frac + (r.unicode 5)))] (in {////analysis.#Primitive primitive}))) (def: .public (corresponds? analysis synthesis) @@ -74,25 +74,25 @@ (def: .public test Test (<| (_.context (%.symbol (symbol ////synthesis.#Primitive))) - (`` ($_ _.and - (~~ (template [<analysis> <synthesis> <generator>] - [(do r.monad - [expected <generator>] - (_.test (%.symbol (symbol <synthesis>)) - (|> {////analysis.#Primitive {<analysis> expected}} - (//.phase archive.empty) - (phase.result [///bundle.empty ////synthesis.init]) - (pipe.case - {try.#Success {////synthesis.#Primitive {<synthesis> actual}}} - (same? expected actual) + (`` (all _.and + (~~ (template [<analysis> <synthesis> <generator>] + [(do r.monad + [expected <generator>] + (_.test (%.symbol (symbol <synthesis>)) + (|> {////analysis.#Primitive {<analysis> expected}} + (//.phase archive.empty) + (phase.result [///bundle.empty ////synthesis.init]) + (pipe.case + {try.#Success {////synthesis.#Primitive {<synthesis> actual}}} + (same? expected actual) - _ - false))))] + _ + false))))] - [////analysis.#Unit ////synthesis.#Text (r#in ////synthesis.unit)] - [////analysis.#Bit ////synthesis.#Bit r.bit] - [////analysis.#Nat ////synthesis.#I64 (r#each .i64 r.nat)] - [////analysis.#Int ////synthesis.#I64 (r#each .i64 r.int)] - [////analysis.#Rev ////synthesis.#I64 (r#each .i64 r.rev)] - [////analysis.#Frac ////synthesis.#F64 r.frac] - [////analysis.#Text ////synthesis.#Text (r.unicode 5)])))))) + [////analysis.#Unit ////synthesis.#Text (r#in ////synthesis.unit)] + [////analysis.#Bit ////synthesis.#Bit r.bit] + [////analysis.#Nat ////synthesis.#I64 (r#each .i64 r.nat)] + [////analysis.#Int ////synthesis.#I64 (r#each .i64 r.int)] + [////analysis.#Rev ////synthesis.#I64 (r#each .i64 r.rev)] + [////analysis.#Frac ////synthesis.#F64 r.frac] + [////analysis.#Text ////synthesis.#Text (r.unicode 5)])))))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/structure.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/structure.lux index d0383c9a7..08a90da4b 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/structure.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/structure.lux @@ -79,7 +79,7 @@ (def: .public test Test (<| (_.context (%.symbol (symbol ////synthesis.#Structure))) - ($_ _.and - ..variant - ..tuple - ))) + (all _.and + ..variant + ..tuple + ))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/variable.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/variable.lux index f6085d963..7e69f4420 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/variable.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/variable.lux @@ -156,64 +156,64 @@ (def: (path_scenario scenario context) (-> (Scenario Synthesis) (Scenario Path)) - (`` ($_ random.either - ($_ random.either - (do [! random.monad] - [_ (in []) - [expected_then actual_then] (scenario context)] - (in [{synthesis.#Seq {synthesis.#Pop} - {synthesis.#Then expected_then}} - {synthesis.#Seq {synthesis.#Pop} - {synthesis.#Then actual_then}}])) - (do [! random.monad] - [_ (in []) - .let [real_register (dictionary.size (the #necessary context)) - fake_register (n.+ (the #redundants context) - (dictionary.size (the #necessary context)))] - [expected_then actual_then] (scenario (revised #necessary (dictionary.has real_register fake_register) context))] - (in [{synthesis.#Seq {synthesis.#Bind real_register} - {synthesis.#Seq {synthesis.#Pop} - {synthesis.#Then expected_then}}} - {synthesis.#Seq {synthesis.#Bind fake_register} - {synthesis.#Seq {synthesis.#Pop} - {synthesis.#Then actual_then}}}]))) - ($_ random.either - (~~ (template [<tag> <random>] - [(do [! random.monad] - [test <random> - [expected_then actual_then] (scenario context)] - (in [{synthesis.#Seq {synthesis.#Test {<tag> test}} - {synthesis.#Then expected_then}} - {synthesis.#Seq {synthesis.#Test {<tag> test}} - {synthesis.#Then actual_then}}]))] + (`` (all random.either + (all random.either + (do [! random.monad] + [_ (in []) + [expected_then actual_then] (scenario context)] + (in [{synthesis.#Seq {synthesis.#Pop} + {synthesis.#Then expected_then}} + {synthesis.#Seq {synthesis.#Pop} + {synthesis.#Then actual_then}}])) + (do [! random.monad] + [_ (in []) + .let [real_register (dictionary.size (the #necessary context)) + fake_register (n.+ (the #redundants context) + (dictionary.size (the #necessary context)))] + [expected_then actual_then] (scenario (revised #necessary (dictionary.has real_register fake_register) context))] + (in [{synthesis.#Seq {synthesis.#Bind real_register} + {synthesis.#Seq {synthesis.#Pop} + {synthesis.#Then expected_then}}} + {synthesis.#Seq {synthesis.#Bind fake_register} + {synthesis.#Seq {synthesis.#Pop} + {synthesis.#Then actual_then}}}]))) + (all random.either + (~~ (template [<tag> <random>] + [(do [! random.monad] + [test <random> + [expected_then actual_then] (scenario context)] + (in [{synthesis.#Seq {synthesis.#Test {<tag> test}} + {synthesis.#Then expected_then}} + {synthesis.#Seq {synthesis.#Test {<tag> test}} + {synthesis.#Then actual_then}}]))] - [synthesis.#Bit random.bit] - [synthesis.#I64 (# ! each .i64 random.nat)] - [synthesis.#F64 random.frac] - [synthesis.#Text (random.unicode 1)] - ))) - ($_ random.either - (do [! random.monad] - [side ..random_side - [expected_next actual_next] (path_scenario scenario context)] - (in [{synthesis.#Seq {synthesis.#Access {synthesis.#Side side}} - expected_next} - {synthesis.#Seq {synthesis.#Access {synthesis.#Side side}} - actual_next}])) - (do [! random.monad] - [member ..random_member - [expected_next actual_next] (path_scenario scenario context)] - (in [{synthesis.#Seq {synthesis.#Access {synthesis.#Member member}} - expected_next} - {synthesis.#Seq {synthesis.#Access {synthesis.#Member member}} - actual_next}]))) - (do [! random.monad] - [_ (in []) - [expected_left actual_left] (path_scenario scenario context) - [expected_right actual_right] (path_scenario scenario context)] - (in [{synthesis.#Alt expected_left expected_right} - {synthesis.#Alt actual_left actual_right}])) - ))) + [synthesis.#Bit random.bit] + [synthesis.#I64 (# ! each .i64 random.nat)] + [synthesis.#F64 random.frac] + [synthesis.#Text (random.unicode 1)] + ))) + (all random.either + (do [! random.monad] + [side ..random_side + [expected_next actual_next] (path_scenario scenario context)] + (in [{synthesis.#Seq {synthesis.#Access {synthesis.#Side side}} + expected_next} + {synthesis.#Seq {synthesis.#Access {synthesis.#Side side}} + actual_next}])) + (do [! random.monad] + [member ..random_member + [expected_next actual_next] (path_scenario scenario context)] + (in [{synthesis.#Seq {synthesis.#Access {synthesis.#Member member}} + expected_next} + {synthesis.#Seq {synthesis.#Access {synthesis.#Member member}} + actual_next}]))) + (do [! random.monad] + [_ (in []) + [expected_left actual_left] (path_scenario scenario context) + [expected_right actual_right] (path_scenario scenario context)] + (in [{synthesis.#Alt expected_left expected_right} + {synthesis.#Alt actual_left actual_right}])) + ))) (def: (case_scenario scenario context) (-> (Scenario Synthesis) (Scenario Synthesis)) @@ -226,12 +226,12 @@ (def: (branch_scenario scenario context) (-> (Scenario Synthesis) (Scenario Synthesis)) - ($_ random.either - (..let_scenario scenario context) - (..if_scenario scenario context) - (..get_scenario scenario context) - (..case_scenario scenario context) - )) + (all random.either + (..let_scenario scenario context) + (..if_scenario scenario context) + (..get_scenario scenario context) + (..case_scenario scenario context) + )) (def: scope_arity 5) @@ -265,10 +265,10 @@ (def: (loop_scenario scenario context) (-> (Scenario Synthesis) (Scenario Synthesis)) - ($_ random.either - (..scope_scenario scenario context) - (..again_scenario scenario context) - )) + (all random.either + (..scope_scenario scenario context) + (..again_scenario scenario context) + )) (def: (abstraction_scenario scenario context) (-> (Scenario Synthesis) (Scenario Synthesis)) @@ -293,30 +293,30 @@ (def: (function_scenario scenario context) (-> (Scenario Synthesis) (Scenario Synthesis)) - ($_ random.either - (..abstraction_scenario scenario context) - (..apply_scenario scenario context) - )) + (all random.either + (..abstraction_scenario scenario context) + (..apply_scenario scenario context) + )) (def: (control_scenario scenario context) (-> (Scenario Synthesis) (Scenario Synthesis)) - ($_ random.either - (..branch_scenario scenario context) - (..loop_scenario scenario context) - (..function_scenario scenario context) - )) + (all random.either + (..branch_scenario scenario context) + (..loop_scenario scenario context) + (..function_scenario scenario context) + )) (def: (scenario context) (Scenario Synthesis) - ($_ random.either - (..primitive_scenario context) - (..structure_scenario context) - (..control_scenario (..with_redundancy - (..control_scenario - (..with_redundancy - ..structure_scenario))) - context) - )) + (all random.either + (..primitive_scenario context) + (..structure_scenario context) + (..control_scenario (..with_redundancy + (..control_scenario + (..with_redundancy + ..structure_scenario))) + context) + )) (def: default Context @@ -326,11 +326,11 @@ (def: .public test Test (<| (_.covering /._) - ($_ _.and - (do random.monad - [[expected input] (..scenario ..default)] - (_.cover [/.optimization] - (|> (/.optimization input) - (!expect (^.multi {try.#Success actual} - (# synthesis.equivalence = expected actual)))))) - ))) + (all _.and + (do random.monad + [[expected input] (..scenario ..default)] + (_.cover [/.optimization] + (|> (/.optimization input) + (!expect (^.multi {try.#Success actual} + (# synthesis.equivalence = expected actual)))))) + ))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/syntax.lux b/stdlib/source/test/lux/tool/compiler/language/lux/syntax.lux index c253f7107..132d27fb6 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/syntax.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/syntax.lux @@ -37,74 +37,74 @@ (def: code^ (Random Code) (let [numeric^ (is (Random Code) - ($_ r.either - (|> r.bit (r#each code.bit)) - (|> r.nat (r#each code.nat)) - (|> r.int (r#each code.int)) - (|> r.rev (r#each code.rev)) - (|> r.safe_frac (r#each code.frac)))) + (all r.either + (|> r.bit (r#each code.bit)) + (|> r.nat (r#each code.nat)) + (|> r.int (r#each code.int)) + (|> r.rev (r#each code.rev)) + (|> r.safe_frac (r#each code.frac)))) textual^ (is (Random Code) - ($_ r.either - (do r.monad - [size (|> r.nat (r#each (n.% 20)))] - (|> (r.ascii/upper_alpha size) (r#each code.text))) - (|> symbol^ (r#each code.symbol)) - (|> symbol^ (r#each code.tag)))) + (all r.either + (do r.monad + [size (|> r.nat (r#each (n.% 20)))] + (|> (r.ascii/upper_alpha size) (r#each code.text))) + (|> symbol^ (r#each code.symbol)) + (|> symbol^ (r#each code.tag)))) simple^ (is (Random Code) - ($_ r.either - numeric^ - textual^))] + (all r.either + numeric^ + textual^))] (r.rec (function (_ code^) (let [multi^ (do r.monad [size (|> r.nat (r#each (n.% 3)))] (r.list size code^)) composite^ (is (Random Code) - ($_ r.either - (|> multi^ (r#each code.form)) - (|> multi^ (r#each code.tuple)) - (do r.monad - [size (|> r.nat (r#each (n.% 3)))] - (|> (r.list size (r.and code^ code^)) - (r#each code.record)))))] - ($_ r.either - simple^ - composite^)))))) + (all r.either + (|> multi^ (r#each code.form)) + (|> multi^ (r#each code.tuple)) + (do r.monad + [size (|> r.nat (r#each (n.% 3)))] + (|> (r.list size (r.and code^ code^)) + (r#each code.record)))))] + (all r.either + simple^ + composite^)))))) (def: code Test (do [! r.monad] [sample code^] - ($_ _.and - (_.test "Can parse Lux code." - (case (let [source_code (%.code sample)] - (/.parse "" (dictionary.empty text.hash) (text.size source_code) - [location.dummy 0 source_code])) - {.#Left error} - false + (all _.and + (_.test "Can parse Lux code." + (case (let [source_code (%.code sample)] + (/.parse "" (dictionary.empty text.hash) (text.size source_code) + [location.dummy 0 source_code])) + {.#Left error} + false - {.#Right [_ parsed]} - (# code.equivalence = parsed sample))) - (do ! - [other code^] - (_.test "Can parse multiple Lux code nodes." - (let [source_code (format (%.code sample) " " (%.code other)) - source_code//size (text.size source_code)] - (case (/.parse "" (dictionary.empty text.hash) source_code//size - [location.dummy 0 source_code]) - {.#Left error} - false + {.#Right [_ parsed]} + (# code.equivalence = parsed sample))) + (do ! + [other code^] + (_.test "Can parse multiple Lux code nodes." + (let [source_code (format (%.code sample) " " (%.code other)) + source_code//size (text.size source_code)] + (case (/.parse "" (dictionary.empty text.hash) source_code//size + [location.dummy 0 source_code]) + {.#Left error} + false - {.#Right [remaining =sample]} - (case (/.parse "" (dictionary.empty text.hash) source_code//size - remaining) - {.#Left error} - false + {.#Right [remaining =sample]} + (case (/.parse "" (dictionary.empty text.hash) source_code//size + remaining) + {.#Left error} + false - {.#Right [_ =other]} - (and (# code.equivalence = sample =sample) - (# code.equivalence = other =other))))))) - ))) + {.#Right [_ =other]} + (and (# code.equivalence = sample =sample) + (# code.equivalence = other =other))))))) + ))) (def: comment_text^ (Random Text) @@ -124,23 +124,23 @@ (do r.monad [sample code^ comment comment^] - ($_ _.and - (_.test "Can handle comments." - (case (let [source_code (format comment (%.code sample)) - source_code//size (text.size source_code)] - (/.parse "" (dictionary.empty text.hash) source_code//size - [location.dummy 0 source_code])) - {.#Left error} - false + (all _.and + (_.test "Can handle comments." + (case (let [source_code (format comment (%.code sample)) + source_code//size (text.size source_code)] + (/.parse "" (dictionary.empty text.hash) source_code//size + [location.dummy 0 source_code])) + {.#Left error} + false - {.#Right [_ parsed]} - (# code.equivalence = parsed sample))) - ))) + {.#Right [_ parsed]} + (# code.equivalence = parsed sample))) + ))) (def: .public test Test (<| (_.context (symbol.module (symbol /._))) - ($_ _.and - ..code - ..comments - ))) + (all _.and + ..code + ..comments + ))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/synthesis/access.lux b/stdlib/source/test/lux/tool/compiler/language/lux/synthesis/access.lux index cb6859350..c828ed855 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/synthesis/access.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/synthesis/access.lux @@ -8,7 +8,7 @@ (def: .public test Test - ($_ _.and - /side.test - /member.test - )) + (all _.and + /side.test + /member.test + )) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/synthesis/access/member.lux b/stdlib/source/test/lux/tool/compiler/language/lux/synthesis/access/member.lux index db4f15bfa..a7c72b262 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/synthesis/access/member.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/synthesis/access/member.lux @@ -17,10 +17,10 @@ (def: .public random (Random /.Member) - ($_ random.and - random.nat - random.bit - )) + (all random.and + random.nat + random.bit + )) (def: .public test Test @@ -29,13 +29,13 @@ (do [! random.monad] [left ..random right ..random] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) - (_.for [/.hash] - ($hash.spec /.hash ..random)) - - (_.cover [/.format] - (bit#= (# /.equivalence = left right) - (text#= (/.format left) (/.format right)))) - )))) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + (_.for [/.hash] + ($hash.spec /.hash ..random)) + + (_.cover [/.format] + (bit#= (# /.equivalence = left right) + (text#= (/.format left) (/.format right)))) + )))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/synthesis/access/side.lux b/stdlib/source/test/lux/tool/compiler/language/lux/synthesis/access/side.lux index adc2b142d..c5706bc14 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/synthesis/access/side.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/synthesis/access/side.lux @@ -17,10 +17,10 @@ (def: .public random (Random /.Side) - ($_ random.and - random.nat - random.bit - )) + (all random.and + random.nat + random.bit + )) (def: .public test Test @@ -29,13 +29,13 @@ (do [! random.monad] [left ..random right ..random] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) - (_.for [/.hash] - ($hash.spec /.hash ..random)) - - (_.cover [/.format] - (bit#= (# /.equivalence = left right) - (text#= (/.format left) (/.format right)))) - )))) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + (_.for [/.hash] + ($hash.spec /.hash ..random)) + + (_.cover [/.format] + (bit#= (# /.equivalence = left right) + (text#= (/.format left) (/.format right)))) + )))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/synthesis/simple.lux b/stdlib/source/test/lux/tool/compiler/language/lux/synthesis/simple.lux index 568788a0e..32e833ca7 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/synthesis/simple.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/synthesis/simple.lux @@ -19,12 +19,12 @@ (def: .public random (Random /.Simple) - ($_ random.or - random.bit - random.i64 - random.frac - (random.ascii/lower 1) - )) + (all random.or + random.bit + random.i64 + random.frac + (random.ascii/lower 1) + )) (def: .public test Test @@ -33,13 +33,13 @@ (do [! random.monad] [left ..random right ..random] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) - (_.for [/.hash] - ($hash.spec /.hash ..random)) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + (_.for [/.hash] + ($hash.spec /.hash ..random)) - (_.cover [/.format] - (bit#= (text#= (/.format left) (/.format right)) - (# /.equivalence = left right))) - )))) + (_.cover [/.format] + (bit#= (text#= (/.format left) (/.format right)) + (# /.equivalence = left right))) + )))) |