diff options
Diffstat (limited to '')
51 files changed, 3263 insertions, 3263 deletions
diff --git a/stdlib/source/test/lux/tool/compiler/arity.lux b/stdlib/source/test/lux/tool/compiler/arity.lux index cd39f3380..ad89541f5 100644 --- a/stdlib/source/test/lux/tool/compiler/arity.lux +++ b/stdlib/source/test/lux/tool/compiler/arity.lux @@ -20,10 +20,10 @@ (do [! random.monad] [arity (# ! each (n.% 3) random.nat)] (all _.and - (_.cover [/.nullary?] - (bit#= (n.= 0 arity) (/.nullary? arity))) - (_.cover [/.unary?] - (bit#= (n.= 1 arity) (/.unary? arity))) - (_.cover [/.multiary?] - (bit#= (n.>= 2 arity) (/.multiary? arity))) + (_.coverage [/.nullary?] + (bit#= (n.= 0 arity) (/.nullary? arity))) + (_.coverage [/.unary?] + (bit#= (n.= 1 arity) (/.unary? arity))) + (_.coverage [/.multiary?] + (bit#= (n.>= 2 arity) (/.multiary? arity))) )))) 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 e4f33919f..f620d1a10 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/analysis.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/analysis.lux @@ -109,21 +109,21 @@ frac random.frac text (random.lower_case 1)] (`` (all _.and - (_.cover [/.unit] - (case (/.unit) - (pattern (/.unit)) - true + (_.coverage [/.unit] + (case (/.unit) + (pattern (/.unit)) + true + + _ + false)) + (~~ (template [<tag> <expected>] + [(_.coverage [<tag>] + (case (<tag> <expected>) + (pattern (<tag> actual)) + (same? <expected> actual) _ - false)) - (~~ (template [<tag> <expected>] - [(_.cover [<tag>] - (case (<tag> <expected>) - (pattern (<tag> actual)) - (same? <expected> actual) - - _ - false))] + false))] [/.bit bit] [/.nat nat] @@ -141,26 +141,26 @@ expected_lefts random.nat expected_right? random.bit] (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)) + (_.coverage [/.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))) + (_.coverage [/.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 @@ -171,13 +171,13 @@ expected_variable /variable.random] (`` (all _.and (~~ (template [<tag> <expected>] - [(_.cover [<tag>] - (case (<tag> <expected>) - (pattern (<tag> actual)) - (same? <expected> actual) + [(_.coverage [<tag>] + (case (<tag> <expected>) + (pattern (<tag> actual)) + (same? <expected> actual) - _ - false))] + _ + false))] [/.local expected_register] [/.foreign expected_register] @@ -202,24 +202,24 @@ expected_parameter/0 (..random 2) expected_parameter/1 (..random 2)] (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)) + (_.coverage [/.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)) + (_.coverage [/.no_op] + (case (/.no_op expected_parameter/0) + (pattern (/.no_op actual)) + (same? expected_parameter/0 actual) + + _ + false)) ))) (def: test|case @@ -228,14 +228,14 @@ [expected_input (..random 2) expected_match (random_match 2 (..random 2))] (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)) + (_.coverage [/.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)) ))) (with_expansions [<id> (static.random_nat) @@ -258,71 +258,71 @@ state/1 (has .#location location/1 (/.state (/.info version/1 host/1 configuration)))]] (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)))) + (_.coverage [/.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))) + (_.coverage [/.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))) + (_.coverage [/.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))) + (_.coverage [/.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))) + (_.coverage [/.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 @@ -343,116 +343,116 @@ .let [state (has .#location location (/.state (/.info version host configuration)))]] (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) + (_.coverage [/.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))))) + (_.coverage [/.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 [/.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)))) + _ + false)))) + (_.coverage [/.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))) + (_.coverage [/.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)))) + (_.coverage [/.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)))) + (_.coverage [/.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)))) + (_.coverage [/.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)))) + (_.coverage [/.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 @@ -477,9 +477,9 @@ ..test|phase) (_.for [/.State+] ..test|state) - (_.cover [/.format] - (bit#= (# /.equivalence = left right) - (text#= (/.format left) (/.format right)))) + (_.coverage [/.format] + (bit#= (# /.equivalence = left right) + (text#= (/.format left) (/.format right)))) /complex.test /inference.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 5d331f85e..2a351ec37 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 @@ -26,20 +26,20 @@ lefts random.nat right? random.bit] (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)))) + (_.coverage [/.tag /.lefts] + (and (|> lefts + (/.tag right?) + (/.lefts right?) + (n.= lefts)) + (|> tag + (/.lefts right?) + (/.tag right?) + (n.= tag)))) + (_.coverage [/.choice] + (let [[lefts right?] (/.choice multiplicity tag)] + (if right? + (n.= (-- tag) lefts) + (n.= tag lefts)))) ))) (def: .public (random multiplicity it) @@ -70,7 +70,7 @@ (do random.monad [left random right random] - (_.cover [/.format] - (bit#= (# (/.equivalence n.equivalence) = left right) - (text#= (/.format %.nat left) (/.format %.nat right))))) + (_.coverage [/.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 3bfe7d2fb..01d4e8481 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 @@ -154,12 +154,12 @@ (_.for [/.equivalence] ($equivalence.spec /.equivalence ..random)) - (_.cover [/.exhaustive?] - (bit#= (/#= {/.#Exhaustive} left) - (/.exhaustive? left))) - (_.cover [/.format] - (bit#= (/#= left right) - (text#= (/.format left) (/.format right)))) + (_.coverage [/.exhaustive?] + (bit#= (/#= {/.#Exhaustive} left) + (/.exhaustive? left))) + (_.coverage [/.format] + (bit#= (/#= left right) + (text#= (/.format left) (/.format right)))) )))) (def: test|coverage @@ -168,29 +168,29 @@ (do [! random.monad] [[expected pattern] ..random_pattern] (all _.and - (_.cover [/.coverage] - (|> pattern + (_.coverage [/.coverage] + (|> pattern + /.coverage + (try#each (/#= expected)) + (try.else false))) + (_.coverage [/.invalid_tuple] + (let [invalid? (..failure? /.invalid_tuple)] + (and (|> (list) + {//complex.#Tuple} + {//pattern.#Complex} /.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)))) + invalid?) + (|> (list pattern) + {//complex.#Tuple} + {//pattern.#Complex} + /.coverage + invalid?) + (|> (list pattern pattern) + {//complex.#Tuple} + {//pattern.#Complex} + /.coverage + invalid? + not)))) )))) (def: random_partial_pattern @@ -213,12 +213,12 @@ [tag/1 expected/1])) expected_minimum (++ (n.max tag/0 tag/1))]] (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])))) + (_.coverage [/.minimum] + (and (n.= expected_minimum (/.minimum [{.#None} cases])) + (n.= expected_maximum (/.minimum [{.#Some expected_maximum} cases])))) + (_.coverage [/.maximum] + (and (n.= n#top (/.maximum [{.#None} cases])) + (n.= expected_maximum (/.maximum [{.#Some expected_maximum} cases])))) )))) (def: random_value_pattern @@ -257,200 +257,200 @@ tag/0 random_tag tag/1 (random.only (|>> (n.= tag/0) not) random_tag)] (all _.and - (_.cover [/.composite] - (let [composes_simples! - (`` (and (|> (/.composite {/.#Bit bit} {/.#Bit (not bit)}) - (try#each (/#= {/.#Exhaustive})) + (_.coverage [/.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)) - (|> {/.#Bit bit} + (|> {<tag> (set.of_list <hash> (list <value>))} (/.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)] - )))) + (try.else false))] - 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}))) + [/.#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_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))))) + 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_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})) + 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)) - (|> (/.composite expected/1 - {/.#Seq expected/0 expected/1}) - (try#each (/#= {/.#Alt expected/1 - {/.#Seq expected/0 expected/1}})) - (try.else false)) - (|> (/.composite expected/0 + (|> {/.#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}) - (try#each (/#= expected/0)) - (try.else false))) + 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]))})))))) + 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!))) + (_.coverage [/.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)))))) + (_.coverage [/.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 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 cb50147c5..b35d2f857 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 @@ -108,107 +108,107 @@ arity (# ! each (n.% 10) random.nat) nats (random.list arity random.nat)] (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))) + (_.coverage [/.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)) + )) + (_.coverage [/.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)))) + (_.coverage [/.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 @@ -227,97 +227,97 @@ .let [[lefts right?] (//complex.choice arity tag)] arbitrary_right? random.bit] (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))) + (_.coverage [/.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! + ))) + (_.coverage [/.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 @@ -355,43 +355,43 @@ record (type.tuple (list#each product.left types/*,terms/*)) terms (list#each product.right types/*,terms/*)]] (all _.and - (_.cover [/.record] - (let [can_infer_record! - (record? record {.#None} arity terms) + (_.coverage [/.record] + (let [can_infer_record! + (record? record {.#None} arity terms) - names_do_not_matter! - (record? {.#Named name 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_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! - can_handle_universal_quantification! - can_handle_existential_quantification! - ))) - (_.cover [/.not_a_record] - (|> (/.record arity type/0) - (/phase.result state) - (..fails? /.not_a_record))) + 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! + can_handle_universal_quantification! + can_handle_existential_quantification! + ))) + (_.coverage [/.not_a_record] + (|> (/.record arity type/0) + (/phase.result state) + (..fails? /.not_a_record))) ))) (def: .public test @@ -410,14 +410,14 @@ ..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)))) + (_.coverage [/.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 23ba015dd..18fc868ec 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 @@ -78,34 +78,34 @@ (list.repeated multiplicity) list#conjoint)]}))]]) (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)) + (_.coverage [/.expansion] + (|> (/.expansion ..expander name multiple (list mono)) + (meta.result lux) + (try#each (# (list.equivalence code.equivalence) = + (list.repeated multiplicity mono))) + (try.else false))) + (_.coverage [/.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))) + (_.coverage [/.single_expansion] + (|> (/.single_expansion ..expander name singular poly) + (meta.result lux) + (try#each (code#= (|> poly (list.item choice) maybe.trusted))) + (try.else false))) + (_.coverage [/.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 418f5824b..96d27be9c 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 @@ -68,67 +68,67 @@ expected_import (random.lower_case 2) expected_alias (random.lower_case 3)] (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))] + (_.coverage [/.empty] + (..new? hash (/.empty hash))) + (_.coverage [/.create] + (|> (do /phase.monad + [_ (/.create hash name)] + (/extension.lifted (meta.module name))) + (/phase.result state) + (try#each (..new? hash)) + (try.else false))) + (_.coverage [/.exists?] + (|> (do /phase.monad + [pre (/.exists? name) + _ (/.create hash name) + post (/.exists? name)] + (in (and (not pre) post))) + (/phase.result state) + (try.else false))) + (_.coverage [/.with] + (|> (do /phase.monad + [[it _] (/.with hash name + (in []))] + (in it)) + (/phase.result state) + (try#each (..new? hash)) + (try.else false))) + (_.coverage [/.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]))))) + (_.coverage [/.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 @@ -141,59 +141,59 @@ hash random.nat] (`` (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)))] + [(_.coverage [<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)))] + (_.coverage [/.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] + )))) + (_.coverage [/.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 @@ -219,53 +219,53 @@ .let [definition {.#Definition [public? def_type []]} alias {.#Alias [module_name def_name]}]] (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))) + (_.coverage [/.define] + (`` (and (~~ (template [<global>] + [(|> (/.with hash module_name + (/.define def_name <global>)) (/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))] + {try.#Failure _} false))] - [{.#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 + [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))))) + (_.coverage [/.cannot_define_more_than_once] + (`` (and (~~ (template [<global>] + [(|> (/.with hash module_name (do /phase.monad - [_ (/.define def_name definition) - _ (/.define alias_name alias)] - (/.define alias_name alias))) + [_ (/.define def_name <global>)] + (/.define def_name <global>))) (/phase.result state) (pipe.case {try.#Success _} false - {try.#Failure _} true))))) + {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 @@ -288,58 +288,58 @@ (random.set text.hash (-- arity)) (# ! each set.list))] (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>)))] + (_.coverage [/.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]))))) + (_.coverage [/.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]))))) + (_.coverage [/.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 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 01eb25f11..ac6ce0392 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 @@ -51,24 +51,24 @@ (_.for [/.equivalence] ($equivalence.spec /.equivalence ..random)) - (_.cover [/.format] - (bit#= (# /.equivalence = left right) - (text#= (/.format left) (/.format right)))) - (_.cover [/.unit] - (case (/.unit) - (pattern (/.unit)) - true + (_.coverage [/.format] + (bit#= (# /.equivalence = left right) + (text#= (/.format left) (/.format right)))) + (_.coverage [/.unit] + (case (/.unit) + (pattern (/.unit)) + true - _ - false)) + _ + false)) (~~ (template [<tag> <value>] - [(_.cover [<tag>] - (case (<tag> <value>) - (pattern (<tag> actual)) - (same? <value> actual) + [(_.coverage [<tag>] + (case (<tag> <value>) + (pattern (<tag> actual)) + (same? <value> actual) - _ - false))] + _ + false))] [/.bind expected_register] [/.bit expected_bit] @@ -78,35 +78,35 @@ [/.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)) + (_.coverage [/.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)) + (_.coverage [/.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 f6bedb278..9de7bd8ec 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 @@ -59,146 +59,146 @@ type/0 ($type.random 0) type/1 ($type.random 0)] (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 + (_.coverage [/.variable] + (|> (/.variable name/0) + /.with + (//phase.result state) + (try#each (|>> product.right + (pipe.case + {.#None} true + {.#Some _} false))) + (try.else false))) + (_.coverage [/.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))) + (_.coverage [/.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))) + (_.coverage [/.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))))) + (_.coverage [/.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)))) + (_.coverage [/.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)))) + (_.coverage [/.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))) + + (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))) + (_.coverage [/.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 - (maybe#each (..local? type/0 0)) - (maybe.else false))) - (try.else false))) - (_.cover [/.next] - (|> (<| (do [! //phase.monad] + (list#= (list)))) + (try.else false)) + (|> (<| /.with + (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 - (/.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) + [[scope/1 _] (/.with (/.variable name/0))] + (in [register/0 (/.environment scope/1)]))) (//phase.result state) - (exception.otherwise (exception.match? /.drained)))) - (_.cover [/.with] + (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 - [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'']))))) + (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 (_ [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))))) + (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 12448028f..ba3ba6096 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 @@ -39,7 +39,7 @@ (do random.monad [left ..random right ..random] - (_.cover [/.format] - (bit#= (# /.equivalence = left right) - (text#= (/.format left) (/.format right))))) + (_.coverage [/.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 ed8f42dde..b3634b2e8 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 @@ -52,84 +52,84 @@ ..primitive) module (random.lower_case 1)] (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)))) + (_.coverage [/.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)))) + (_.coverage [/.inferring] + (|> (/.inference expected) + /.inferring + (/module.with 0 module) + (/phase#each product.right) + (/phase.result state) + (try#each (|>> product.left (type#= expected))) + (try.else false))) + (_.coverage [/.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))) + (_.coverage [/.existential /.existential?] + (|> (do /phase.monad + [:it: /.existential] + (in (/.existential? :it:))) + (/module.with 0 module) + (/phase#each product.right) + (/phase.result state) + (try.else false))) + (_.coverage [/.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 9e97fd917..7e0445312 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 @@ -922,41 +922,41 @@ $abstraction/1 (# ! each code.local (random.lower_case 13)) $parameter/1 (# ! each code.local (random.lower_case 14))]) (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))})] - )) - ))) + (_.coverage [/.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) + )) + (_.coverage [/.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 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 4eb36a953..a62410d37 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 @@ -67,77 +67,77 @@ $binding/1 (# ! each code.local (random.lower_case 4)) $binding/2 (# ! each code.local (random.lower_case 5))] (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)))))) + (_.coverage [/.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))))) + (_.coverage [/.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]) @@ -515,38 +515,23 @@ bit/0 random.bit nat/0 random.nat] (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) + (_.coverage [/.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]))) + (_.coverage [/.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))))) + (_.coverage [/.non_exhaustive] + (let [non_exhaustive? (is (-> (List [Code Code]) Bit) (function (_ branches) (|> (do //phase.monad [analysis (|> (/.case ..analysis branches archive.empty simple/0) @@ -556,80 +541,95 @@ (//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))))))) + (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])))))) + (_.coverage [/.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]))))) + (_.coverage [/.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)))))) + (_.coverage [/.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 4bdb21d48..cea405776 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 @@ -142,50 +142,50 @@ (list.item tag) (maybe.else [Any (' [])]))]] (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 - [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))))) + (_.coverage [/.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) @@ -193,21 +193,21 @@ (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))) + (_.coverage [/.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)))) + (_.coverage [/.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))) ))) ))) @@ -234,51 +234,51 @@ (list.item tag) (maybe.else ""))]] (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. - ))) + (_.coverage [/.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) @@ -299,133 +299,133 @@ productT (type.tuple (list#each product.left types/*,terms/*)) expected (list#each product.right types/*,terms/*)]] (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.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)) + (_.coverage [/.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))))) + _ + 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)))))) + (_.coverage [/.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 @@ -471,161 +471,161 @@ _ slots/0)]] (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:)] - (/.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) - (|> (do //phase.monad - [_ (//module.declare_labels true slots/0 false :record:)] - (/.order pattern_matching? input)) - //scope.with - (//module.with 0 module) - (//phase#each (|>> product.right 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)) - - _ - 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)))) + (_.coverage [/.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))))) + (_.coverage [/.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:)] + (/.order pattern_matching? input)) + //scope.with + (//module.with 0 module) + (//phase#each (|>> product.right 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)) + + _ + 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. + ))) + (_.coverage [/.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)))) + (_.coverage [/.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)))))) + (_.coverage [/.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)))) + (_.coverage [/.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 @@ -645,15 +645,15 @@ ..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)))) + (_.coverage [/.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 f14599150..5f002867e 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 @@ -81,106 +81,84 @@ $argument/0 (code.local argument/0) $argument/1 (code.local argument/1)]] (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) + (_.coverage [/.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))))] - (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)))) + 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:) - (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) + _ + 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? (type ((All (_ a) (-> a a)) output/0)) term/0) - (not (function? (type ((All (_ a) (-> a a)) output/1)) term/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 ((Ex (_ a) (-> a a)) output/0)) term/0) - (not (function? (type ((Ex (_ 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?' (-> 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? (type ((Ex (_ a) (-> a a)) output/0)) term/0) + (not (function? (type ((Ex (_ a) (-> a a)) output/1)) term/0)) - _ - 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)) + (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)))) + _ + 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)) - (|> (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)))) - _ - 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)))] + [[@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 @@ -190,7 +168,29 @@ (//module.with 0 module/0) (//phase#each product.right) (//phase.result state) - (exception.otherwise (text.contains? (the exception.#label /.cannot_analyse))))) + (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)])))))) + (_.coverage [/.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))))) ))) (def: test|apply @@ -205,48 +205,48 @@ output/0 ($type.random 0) module/0 (random.lower_case 1)] (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 + (_.coverage [/.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)))) + (_.coverage [/.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 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 66df51d4e..ff0b55372 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 @@ -43,181 +43,181 @@ expected_label (random.lower_case 4) record? random.bit] (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) + (_.coverage [/.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!))) + (_.coverage [/.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)]})]})))) + (_.coverage [/.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)]})]})))) + (_.coverage [/.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 c096da534..dceaee0b2 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 @@ -85,15 +85,15 @@ configuration ($configuration.random 5) .let [state (/analysis.state (/analysis.info version host configuration))]] (`` (all _.and - (_.cover [/.unit] - (..analysis state module .Any /.unit - (|>> (pipe.case (pattern (/analysis.unit)) true _ false)))) + (_.coverage [/.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))))] + (_.coverage [<analysis>] + (..analysis state module <type> (<analysis> sample) + ((..analysis? <type> <tag>) sample))))] [/.bit .Bit random.bit /analysis.bit] [/.nat .Nat random.nat /analysis.nat] 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 59bafc3d7..3833dfa63 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 @@ -44,54 +44,54 @@ dummy (random.only (|>> (i.= state) not) random.int)] (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)))) + (_.coverage [/.read] + (|> (is (/.Operation Int Nat Nat Text) + (/.read %.int)) + (# phase.functor each (text#= (%.int state))) + (phase.result [/.#bundle /.empty + /.#state state]) + (try.else false))) + (_.coverage [/.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))) + (_.coverage [/.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))) + (_.coverage [/.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))) + (_.coverage [/.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 @@ -116,30 +116,30 @@ left random.nat right random.nat] (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) + (_.coverage [/.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))) + (_.coverage [/.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 @@ -154,72 +154,72 @@ left random.nat right random.nat] (all _.and - (_.cover [/.empty] - (dictionary.empty? /.empty)) + (_.coverage [/.empty] + (dictionary.empty? /.empty)) (<| (_.for [/.Extender /.Handler]) (all _.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))))))] - (|> (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 - [_ (/.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)])))] - (|> (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) + (_.coverage [/.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))) + (_.coverage [/.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)))) + (_.coverage [/.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))) + (_.coverage [/.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)))) + (_.coverage [/.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)))) + _ + false)))) (_.for [/.Name] ..test|name) )) @@ -243,35 +243,35 @@ (<| (_.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) + (_.coverage [/.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))) + _ + false)))) + (_.coverage [/.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) 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 cbcd636f4..712eaad17 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 @@ -62,14 +62,14 @@ [antiT antiC] (|> ..primitive (r.only (|>> product.left (type#= primT) not)))] (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)))) + (_.property "Can test for reference equality." + (check_success+ "lux is" (list primC primC) Bit)) + (_.property "Reference equality must be done with elements of the same type." + (check_failure+ "lux is" (list primC antiC) Bit)) + (_.property "Can 'try' risky IO computations." + (check_success+ "lux try" + (list (` ("lux io error" "YOLO"))) + (type (Either Text primT)))) ))) (def: i64 @@ -79,24 +79,24 @@ signedC (|> r.int (# ! each code.int)) paramC (|> r.nat (# ! each code.nat))] (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)) + (_.property "i64 'and'." + (check_success+ "lux i64 and" (list paramC subjectC) Nat)) + (_.property "i64 'or'." + (check_success+ "lux i64 or" (list paramC subjectC) Nat)) + (_.property "i64 'xor'." + (check_success+ "lux i64 xor" (list paramC subjectC) Nat)) + (_.property "i64 left-shift." + (check_success+ "lux i64 left-shift" (list paramC subjectC) Nat)) + (_.property "i64 logical-right-shift." + (check_success+ "lux i64 logical-right-shift" (list paramC subjectC) Nat)) + (_.property "i64 arithmetic-right-shift." + (check_success+ "lux i64 arithmetic-right-shift" (list paramC signedC) Int)) + (_.property "i64 equivalence." + (check_success+ "lux i64 =" (list paramC subjectC) Bit)) + (_.property "i64 addition." + (check_success+ "lux i64 +" (list paramC subjectC) Int)) + (_.property "i64 subtraction." + (check_success+ "lux i64 -" (list paramC subjectC) Int)) ))) (def: int @@ -105,18 +105,18 @@ [subjectC (|> r.int (# ! each code.int)) paramC (|> r.int (# ! each code.int))] (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)) + (_.property "Can multiply integers." + (check_success+ "lux i64 *" (list paramC subjectC) Int)) + (_.property "Can divide integers." + (check_success+ "lux i64 /" (list paramC subjectC) Int)) + (_.property "Can calculate remainder of integers." + (check_success+ "lux i64 %" (list paramC subjectC) Int)) + (_.property "Can compare integers." + (check_success+ "lux i64 <" (list paramC subjectC) Bit)) + (_.property "Can convert integer to text." + (check_success+ "lux i64 char" (list subjectC) Text)) + (_.property "Can convert integer to fraction." + (check_success+ "lux i64 f64" (list subjectC) Frac)) ))) (def: frac @@ -126,32 +126,32 @@ paramC (|> r.safe_frac (# ! each code.frac)) encodedC (|> r.safe_frac (# ! each (|>> %.frac code.text)))] (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)))) + (_.property "Can add frac numbers." + (check_success+ "lux f64 +" (list paramC subjectC) Frac)) + (_.property "Can subtract frac numbers." + (check_success+ "lux f64 -" (list paramC subjectC) Frac)) + (_.property "Can multiply frac numbers." + (check_success+ "lux f64 *" (list paramC subjectC) Frac)) + (_.property "Can divide frac numbers." + (check_success+ "lux f64 /" (list paramC subjectC) Frac)) + (_.property "Can calculate remainder of frac numbers." + (check_success+ "lux f64 %" (list paramC subjectC) Frac)) + (_.property "Can test equivalence of frac numbers." + (check_success+ "lux f64 =" (list paramC subjectC) Bit)) + (_.property "Can compare frac numbers." + (check_success+ "lux f64 <" (list paramC subjectC) Bit)) + (_.property "Can obtain minimum frac number." + (check_success+ "lux f64 min" (list) Frac)) + (_.property "Can obtain maximum frac number." + (check_success+ "lux f64 max" (list) Frac)) + (_.property "Can obtain smallest frac number." + (check_success+ "lux f64 smallest" (list) Frac)) + (_.property "Can convert frac number to integer." + (check_success+ "lux f64 i64" (list subjectC) Int)) + (_.property "Can convert frac number to text." + (check_success+ "lux f64 encode" (list subjectC) Text)) + (_.property "Can convert text to frac number." + (check_success+ "lux f64 decode" (list encodedC) (type (Maybe Frac)))) ))) (def: text @@ -163,20 +163,20 @@ fromC (|> r.nat (# ! each code.nat)) toC (|> r.nat (# ! each code.nat))] (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)) + (_.property "Can test text equivalence." + (check_success+ "lux text =" (list paramC subjectC) Bit)) + (_.property "Compare texts in lexicographical order." + (check_success+ "lux text <" (list paramC subjectC) Bit)) + (_.property "Can concatenate one text to another." + (check_success+ "lux text concat" (list subjectC paramC) Text)) + (_.property "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)))) + (_.property "Can query the size/length of a text." + (check_success+ "lux text size" (list subjectC) Nat)) + (_.property "Can obtain the character code of a text at a given index." + (check_success+ "lux text char" (list fromC subjectC) Nat)) + (_.property "Can clip a piece of text between 2 indices." + (check_success+ "lux text clip" (list fromC toC subjectC) Text)) ))) (def: io @@ -185,12 +185,12 @@ [logC (|> (r.unicode 5) (# ! each code.text)) exitC (|> r.int (# ! each code.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)) + (_.property "Can log messages to standard output." + (check_success+ "lux io log" (list logC) Any)) + (_.property "Can throw a run-time error." + (check_success+ "lux io error" (list logC) Nothing)) + (_.property "Can query the current time (as milliseconds since epoch)." + (check_success+ "lux io current-time" (list) Int)) ))) (def: .public 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 4ea071954..ee7bdec19 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 @@ -49,12 +49,12 @@ [[{analysis.#Bind temp} {analysis.#Reference (////reference.local temp)}] (list)]])]] - (_.cover [/.synthesize_masking] - (|> maskA - (//.phase archive.empty) - (phase.result [///bundle.empty synthesis.init]) - (try#each (//primitive.corresponds? maskedA)) - (try.default false))))) + (_.coverage [/.synthesize_masking] + (|> maskA + (//.phase archive.empty) + (phase.result [///bundle.empty synthesis.init]) + (try#each (//primitive.corresponds? maskedA)) + (try.default false))))) (def: let_test Test @@ -67,18 +67,18 @@ [[{analysis.#Bind registerA} outputA] (list)]])]] - (_.cover [/.synthesize_let] - (|> letA - (//.phase archive.empty) - (phase.result [///bundle.empty synthesis.init]) - (pipe.case - (pattern {try.#Success (synthesis.branch/let [inputS registerS outputS])}) - (and (n.= registerA registerS) - (//primitive.corresponds? inputA inputS) - (//primitive.corresponds? outputA outputS)) + (_.coverage [/.synthesize_let] + (|> letA + (//.phase archive.empty) + (phase.result [///bundle.empty synthesis.init]) + (pipe.case + (pattern {try.#Success (synthesis.branch/let [inputS registerS outputS])}) + (and (n.= registerA registerS) + (//primitive.corresponds? inputA inputS) + (//primitive.corresponds? outputA outputS)) - _ - false))))) + _ + false))))) (def: if_test Test @@ -96,18 +96,18 @@ ifA (if then|else (analysis.case [inputA [thenB (list elseB)]]) (analysis.case [inputA [elseB (list thenB)]]))]] - (_.cover [/.synthesize_if] - (|> ifA - (//.phase archive.empty) - (phase.result [///bundle.empty synthesis.init]) - (pipe.case - (pattern {try.#Success (synthesis.branch/if [inputS thenS elseS])}) - (and (//primitive.corresponds? inputA inputS) - (//primitive.corresponds? thenA thenS) - (//primitive.corresponds? elseA elseS)) + (_.coverage [/.synthesize_if] + (|> ifA + (//.phase archive.empty) + (phase.result [///bundle.empty synthesis.init]) + (pipe.case + (pattern {try.#Success (synthesis.branch/if [inputS thenS elseS])}) + (and (//primitive.corresponds? inputA inputS) + (//primitive.corresponds? thenA thenS) + (//primitive.corresponds? elseA elseS)) - _ - false))))) + _ + false))))) (def: random_member (Random synthesis.Member) @@ -156,17 +156,17 @@ .let [getA (analysis.case [recordA [[pattern {analysis.#Reference (////reference.local @member)}] (list)]])]] - (_.cover [/.synthesize_get] - (|> getA - (//.phase archive.empty) - (phase.result [///bundle.empty synthesis.init]) - (pipe.case - (pattern {try.#Success (synthesis.branch/get [pathS recordS])}) - (and (# (list.equivalence (sum.equivalence n.= n.=)) = pathA pathS) - (//primitive.corresponds? recordA recordS)) + (_.coverage [/.synthesize_get] + (|> getA + (//.phase archive.empty) + (phase.result [///bundle.empty synthesis.init]) + (pipe.case + (pattern {try.#Success (synthesis.branch/get [pathS recordS])}) + (and (# (list.equivalence (sum.equivalence n.= n.=)) = pathA pathS) + (//primitive.corresponds? recordA recordS)) - _ - false))))) + _ + false))))) (def: random_bit (Random [Path Match]) @@ -334,16 +334,16 @@ (do [! random.monad] [expected_input (# ! each (|>> .i64 synthesis.i64) random.nat) [expected_path match] ..random_case] - (_.cover [/.synthesize_case] - (|> (/.synthesize_case //.phase archive.empty expected_input match) - (phase.result [///bundle.empty synthesis.init]) - (pipe.case - (pattern {try.#Success (synthesis.branch/case [actual_input actual_path])}) - (and (# synthesis.equivalence = expected_input actual_input) - (# synthesis.path_equivalence = expected_path actual_path)) + (_.coverage [/.synthesize_case] + (|> (/.synthesize_case //.phase archive.empty expected_input match) + (phase.result [///bundle.empty synthesis.init]) + (pipe.case + (pattern {try.#Success (synthesis.branch/case [actual_input actual_path])}) + (and (# synthesis.equivalence = expected_input actual_input) + (# synthesis.path_equivalence = expected_path actual_path)) - _ - false))))) + _ + false))))) (def: .public test 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 df05fcc1a..51f9d87b9 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 @@ -430,12 +430,12 @@ Test (do random.monad [[expected input] ..random_abstraction] - (_.cover [/.abstraction] - (|> input - (//.phase archive.empty) - (phase.result [///bundle.empty synthesis.init]) - (!expect (^.multi {try.#Success actual} - (# synthesis.equivalence = expected actual))))))) + (_.coverage [/.abstraction] + (|> input + (//.phase archive.empty) + (phase.result [///bundle.empty synthesis.init]) + (!expect (^.multi {try.#Success actual} + (# synthesis.equivalence = expected actual))))))) (def: application Test @@ -443,19 +443,19 @@ [arity (|> random.nat (# ! each (|>> (n.% 10) (n.max 1)))) funcA //primitive.primitive argsA (random.list arity //primitive.primitive)] - (_.cover [/.apply] - (and (|> (analysis.apply [funcA argsA]) - (//.phase archive.empty) - (phase.result [///bundle.empty synthesis.init]) - (!expect (^.multi (pattern {try.#Success (synthesis.function/apply [funcS argsS])}) - (and (//primitive.corresponds? funcA funcS) - (list.every? (product.uncurried //primitive.corresponds?) - (list.zipped_2 argsA argsS)))))) - (|> (analysis.apply [funcA (list)]) - (//.phase archive.empty) - (phase.result [///bundle.empty synthesis.init]) - (!expect (^.multi {try.#Success funcS} - (//primitive.corresponds? funcA funcS)))))))) + (_.coverage [/.apply] + (and (|> (analysis.apply [funcA argsA]) + (//.phase archive.empty) + (phase.result [///bundle.empty synthesis.init]) + (!expect (^.multi (pattern {try.#Success (synthesis.function/apply [funcS argsS])}) + (and (//primitive.corresponds? funcA funcS) + (list.every? (product.uncurried //primitive.corresponds?) + (list.zipped_2 argsA argsS)))))) + (|> (analysis.apply [funcA (list)]) + (//.phase archive.empty) + (phase.result [///bundle.empty synthesis.init]) + (!expect (^.multi {try.#Success funcS} + (//primitive.corresponds? funcA funcS)))))))) (def: .public test Test 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 7120348e1..2a6cb934b 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 @@ -272,22 +272,22 @@ (# ! 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))) + (_.coverage [/.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 b1b494810..327a799ef 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 @@ -78,16 +78,16 @@ (~~ (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) + (_.property (%.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] 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 08a90da4b..5cfb0ecd6 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 @@ -44,37 +44,37 @@ (-- tagA) tagA)] memberA //primitive.primitive] - (_.test "Can synthesize variants." - (|> (////analysis.variant [lefts right? memberA]) - (//.phase archive.empty) - (phase.result [///bundle.empty ////synthesis.init]) - (pipe.case - (pattern {try.#Success (////synthesis.variant [leftsS right?S valueS])}) - (let [tagS (if right?S (++ leftsS) leftsS)] - (and (n.= tagA tagS) - (|> tagS (n.= (-- size)) (bit#= right?S)) - (//primitive.corresponds? memberA valueS))) - - _ - false))))) + (_.property "Can synthesize variants." + (|> (////analysis.variant [lefts right? memberA]) + (//.phase archive.empty) + (phase.result [///bundle.empty ////synthesis.init]) + (pipe.case + (pattern {try.#Success (////synthesis.variant [leftsS right?S valueS])}) + (let [tagS (if right?S (++ leftsS) leftsS)] + (and (n.= tagA tagS) + (|> tagS (n.= (-- size)) (bit#= right?S)) + (//primitive.corresponds? memberA valueS))) + + _ + false))))) (def: tuple Test (do [! r.monad] [size (|> r.nat (# ! each (|>> (n.% 10) (n.max 2)))) membersA (r.list size //primitive.primitive)] - (_.test "Can synthesize tuple." - (|> (////analysis.tuple membersA) - (//.phase archive.empty) - (phase.result [///bundle.empty ////synthesis.init]) - (pipe.case - (pattern {try.#Success (////synthesis.tuple membersS)}) - (and (n.= size (list.size membersS)) - (list.every? (product.uncurried //primitive.corresponds?) - (list.zipped_2 membersA membersS))) + (_.property "Can synthesize tuple." + (|> (////analysis.tuple membersA) + (//.phase archive.empty) + (phase.result [///bundle.empty ////synthesis.init]) + (pipe.case + (pattern {try.#Success (////synthesis.tuple membersS)}) + (and (n.= size (list.size membersS)) + (list.every? (product.uncurried //primitive.corresponds?) + (list.zipped_2 membersA membersS))) - _ - false))))) + _ + false))))) (def: .public test Test 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 7e69f4420..ee364756a 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 @@ -329,8 +329,8 @@ (all _.and (do random.monad [[expected input] (..scenario ..default)] - (_.cover [/.optimization] - (|> (/.optimization input) - (!expect (^.multi {try.#Success actual} - (# synthesis.equivalence = expected actual)))))) + (_.coverage [/.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 e8dad37cf..21a76beb9 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/syntax.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/syntax.lux @@ -76,34 +76,34 @@ (do [! r.monad] [sample code^] (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 + (_.property "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))) + {.#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 + (_.property "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^ @@ -125,16 +125,16 @@ [sample code^ comment comment^] (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 + (_.property "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 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 a7c72b262..ecd3cd328 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 @@ -35,7 +35,7 @@ (_.for [/.hash] ($hash.spec /.hash ..random)) - (_.cover [/.format] - (bit#= (# /.equivalence = left right) - (text#= (/.format left) (/.format right)))) + (_.coverage [/.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 c5706bc14..f9156206e 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 @@ -35,7 +35,7 @@ (_.for [/.hash] ($hash.spec /.hash ..random)) - (_.cover [/.format] - (bit#= (# /.equivalence = left right) - (text#= (/.format left) (/.format right)))) + (_.coverage [/.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 98beda337..2a6910daa 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 @@ -39,7 +39,7 @@ (_.for [/.hash] ($hash.spec /.hash ..random)) - (_.cover [/.format] - (bit#= (text#= (/.format left) (/.format right)) - (# /.equivalence = left right))) + (_.coverage [/.format] + (bit#= (text#= (/.format left) (/.format right)) + (# /.equivalence = left right))) )))) diff --git a/stdlib/source/test/lux/tool/compiler/meta/archive.lux b/stdlib/source/test/lux/tool/compiler/meta/archive.lux index d43e6a03b..1d0851bbf 100644 --- a/stdlib/source/test/lux/tool/compiler/meta/archive.lux +++ b/stdlib/source/test/lux/tool/compiler/meta/archive.lux @@ -59,139 +59,139 @@ hash random.nat .let [key (/key.key signature content/0)]] (all _.and - (_.cover [/.has /.find] - (|> (do try.monad - [[@module/0 archive] (/.reserve module/0 /.empty) - .let [entry [/.#module [/module.#id @module/0 - /module.#descriptor (..descriptor module/0 hash) - /module.#document (/document.document key content/0)] - /.#output sequence.empty - /.#registry /registry.empty]] - archive (/.has module/0 entry archive) - entry' (/.find module/0 archive)] - (in (same? entry entry'))) - (try.else false))) - (_.cover [/.module_is_only_reserved] - (|> (do try.monad - [[@module/0 archive] (/.reserve module/0 /.empty) - entry' (/.find module/0 archive)] - (in false)) - (exception.otherwise (exception.match? /.module_is_only_reserved)))) - (_.cover [/.cannot_replace_document] - (|> (do try.monad - [[@module/0 archive] (/.reserve module/0 /.empty) - .let [entry/0 [/.#module [/module.#id @module/0 - /module.#descriptor (..descriptor module/0 hash) - /module.#document (/document.document key content/0)] - /.#output sequence.empty - /.#registry /registry.empty] - entry/1 [/.#module [/module.#id @module/0 - /module.#descriptor (..descriptor module/0 hash) - /module.#document (/document.document key content/1)] - /.#output sequence.empty - /.#registry /registry.empty]] - archive (/.has module/0 entry/0 archive) - archive (/.has module/0 entry/1 archive)] - (in false)) - (exception.otherwise (exception.match? /.cannot_replace_document)))) - (_.cover [/.module_must_be_reserved_before_it_can_be_added] - (|> (do try.monad - [.let [entry [/.#module [/module.#id 0 - /module.#descriptor (..descriptor module/0 hash) - /module.#document (/document.document key content/0)] - /.#output sequence.empty - /.#registry /registry.empty]] - archive (/.has module/0 entry /.empty)] - (in false)) - (exception.otherwise (exception.match? /.module_must_be_reserved_before_it_can_be_added)))) - (_.cover [/.archived?] - (|> (do try.monad - [[@module/0 archive] (/.reserve module/0 /.empty) - .let [pre (/.archived? archive module/0) - entry [/.#module [/module.#id @module/0 - /module.#descriptor (..descriptor module/0 hash) - /module.#document (/document.document key content/0)] - /.#output sequence.empty - /.#registry /registry.empty]] - archive (/.has module/0 entry archive) - .let [post (/.archived? archive module/0)]] - (in (and (not pre) post))) - (try.else false))) - (_.cover [/.unknown_document] - (and (|> (do try.monad - [_ (/.id module/0 /.empty)] - (in false)) - (exception.otherwise (exception.match? /.unknown_document))) - (|> (do try.monad - [_ (/.find module/0 /.empty)] - (in false)) - (exception.otherwise (exception.match? /.unknown_document))))) - (_.cover [/.archived] - (|> (do try.monad - [[@module/0 archive] (/.reserve module/0 /.empty) - .let [pre (/.archived archive) - entry [/.#module [/module.#id @module/0 - /module.#descriptor (..descriptor module/0 hash) - /module.#document (/document.document key content/0)] - /.#output sequence.empty - /.#registry /registry.empty]] - archive (/.has module/0 entry archive) - .let [post (/.archived archive) - (open "list#[0]") (list.equivalence text.equivalence)]] - (in (and (list#= (list) pre) - (list#= (list module/0) post)))) - (try.else false))) - (_.cover [/.entries] - (|> (do try.monad - [[@module/0 archive] (/.reserve module/0 /.empty) - .let [pre (/.entries archive) - entry [/.#module [/module.#id @module/0 - /module.#descriptor (..descriptor module/0 hash) - /module.#document (/document.document key content/0)] - /.#output sequence.empty - /.#registry /registry.empty]] - archive (/.has module/0 entry archive)] - (in (and (list.empty? pre) - (case (/.entries archive) - (pattern (list [module/0' @module/0' entry'])) - (and (same? module/0 module/0') - (same? @module/0 @module/0') - (same? entry entry')) + (_.coverage [/.has /.find] + (|> (do try.monad + [[@module/0 archive] (/.reserve module/0 /.empty) + .let [entry [/.#module [/module.#id @module/0 + /module.#descriptor (..descriptor module/0 hash) + /module.#document (/document.document key content/0)] + /.#output sequence.empty + /.#registry /registry.empty]] + archive (/.has module/0 entry archive) + entry' (/.find module/0 archive)] + (in (same? entry entry'))) + (try.else false))) + (_.coverage [/.module_is_only_reserved] + (|> (do try.monad + [[@module/0 archive] (/.reserve module/0 /.empty) + entry' (/.find module/0 archive)] + (in false)) + (exception.otherwise (exception.match? /.module_is_only_reserved)))) + (_.coverage [/.cannot_replace_document] + (|> (do try.monad + [[@module/0 archive] (/.reserve module/0 /.empty) + .let [entry/0 [/.#module [/module.#id @module/0 + /module.#descriptor (..descriptor module/0 hash) + /module.#document (/document.document key content/0)] + /.#output sequence.empty + /.#registry /registry.empty] + entry/1 [/.#module [/module.#id @module/0 + /module.#descriptor (..descriptor module/0 hash) + /module.#document (/document.document key content/1)] + /.#output sequence.empty + /.#registry /registry.empty]] + archive (/.has module/0 entry/0 archive) + archive (/.has module/0 entry/1 archive)] + (in false)) + (exception.otherwise (exception.match? /.cannot_replace_document)))) + (_.coverage [/.module_must_be_reserved_before_it_can_be_added] + (|> (do try.monad + [.let [entry [/.#module [/module.#id 0 + /module.#descriptor (..descriptor module/0 hash) + /module.#document (/document.document key content/0)] + /.#output sequence.empty + /.#registry /registry.empty]] + archive (/.has module/0 entry /.empty)] + (in false)) + (exception.otherwise (exception.match? /.module_must_be_reserved_before_it_can_be_added)))) + (_.coverage [/.archived?] + (|> (do try.monad + [[@module/0 archive] (/.reserve module/0 /.empty) + .let [pre (/.archived? archive module/0) + entry [/.#module [/module.#id @module/0 + /module.#descriptor (..descriptor module/0 hash) + /module.#document (/document.document key content/0)] + /.#output sequence.empty + /.#registry /registry.empty]] + archive (/.has module/0 entry archive) + .let [post (/.archived? archive module/0)]] + (in (and (not pre) post))) + (try.else false))) + (_.coverage [/.unknown_document] + (and (|> (do try.monad + [_ (/.id module/0 /.empty)] + (in false)) + (exception.otherwise (exception.match? /.unknown_document))) + (|> (do try.monad + [_ (/.find module/0 /.empty)] + (in false)) + (exception.otherwise (exception.match? /.unknown_document))))) + (_.coverage [/.archived] + (|> (do try.monad + [[@module/0 archive] (/.reserve module/0 /.empty) + .let [pre (/.archived archive) + entry [/.#module [/module.#id @module/0 + /module.#descriptor (..descriptor module/0 hash) + /module.#document (/document.document key content/0)] + /.#output sequence.empty + /.#registry /registry.empty]] + archive (/.has module/0 entry archive) + .let [post (/.archived archive) + (open "list#[0]") (list.equivalence text.equivalence)]] + (in (and (list#= (list) pre) + (list#= (list module/0) post)))) + (try.else false))) + (_.coverage [/.entries] + (|> (do try.monad + [[@module/0 archive] (/.reserve module/0 /.empty) + .let [pre (/.entries archive) + entry [/.#module [/module.#id @module/0 + /module.#descriptor (..descriptor module/0 hash) + /module.#document (/document.document key content/0)] + /.#output sequence.empty + /.#registry /registry.empty]] + archive (/.has module/0 entry archive)] + (in (and (list.empty? pre) + (case (/.entries archive) + (pattern (list [module/0' @module/0' entry'])) + (and (same? module/0 module/0') + (same? @module/0 @module/0') + (same? entry entry')) - _ - false)))) - (try.else false))) - (_.cover [/.export /.import] - (|> (do try.monad - [[@module/0 archive] (/.reserve module/0 /.empty) - [@module/1 archive] (/.reserve module/1 archive) - .let [entry/0 [/.#module [/module.#id @module/0 - /module.#descriptor (..descriptor module/0 hash) - /module.#document (/document.document key content/0)] - /.#output sequence.empty - /.#registry /registry.empty] - entry/1 [/.#module [/module.#id @module/1 - /module.#descriptor (..descriptor module/1 hash) - /module.#document (/document.document key content/1)] - /.#output sequence.empty - /.#registry /registry.empty]] - archive (/.has module/0 entry/0 archive) - archive (/.has module/1 entry/1 archive) - .let [pre (/.reserved archive)] - archive (|> archive - (/.export version) - (/.import version)) - .let [post (/.reserved archive)]] - (in (set#= (set.of_list text.hash pre) - (set.of_list text.hash post)))) - (try.else false))) - (_.cover [/.version_mismatch] - (|> (do try.monad - [archive (|> /.empty - (/.export version) - (/.import fake_version))] - (in false)) - (exception.otherwise (exception.match? /.version_mismatch)))) + _ + false)))) + (try.else false))) + (_.coverage [/.export /.import] + (|> (do try.monad + [[@module/0 archive] (/.reserve module/0 /.empty) + [@module/1 archive] (/.reserve module/1 archive) + .let [entry/0 [/.#module [/module.#id @module/0 + /module.#descriptor (..descriptor module/0 hash) + /module.#document (/document.document key content/0)] + /.#output sequence.empty + /.#registry /registry.empty] + entry/1 [/.#module [/module.#id @module/1 + /module.#descriptor (..descriptor module/1 hash) + /module.#document (/document.document key content/1)] + /.#output sequence.empty + /.#registry /registry.empty]] + archive (/.has module/0 entry/0 archive) + archive (/.has module/1 entry/1 archive) + .let [pre (/.reserved archive)] + archive (|> archive + (/.export version) + (/.import version)) + .let [post (/.reserved archive)]] + (in (set#= (set.of_list text.hash pre) + (set.of_list text.hash post)))) + (try.else false))) + (_.coverage [/.version_mismatch] + (|> (do try.monad + [archive (|> /.empty + (/.export version) + (/.import fake_version))] + (in false)) + (exception.otherwise (exception.match? /.version_mismatch)))) ))) (def: .public test @@ -207,44 +207,44 @@ hash random.nat .let [key (/key.key signature content/0)]]) (all _.and - (_.cover [/.empty] - (list.empty? (/.entries /.empty))) - (_.cover [/.reserve /.id] - (|> (do try.monad - [[@module/0 archive] (/.reserve module/0 /.empty) - [@module/1 archive] (/.reserve module/1 archive) - @module/0' (/.id module/0 archive) - @module/1' (/.id module/1 archive)] - (in (and (same? @module/0 @module/0') - (same? @module/1 @module/1')))) - (try.else false))) - (_.cover [/.reserved] - (|> (do try.monad - [[@module/0 archive] (/.reserve module/0 /.empty) - [@module/1 archive] (/.reserve module/1 archive)] - (in (set#= (set.of_list text.hash (list module/0 module/1)) - (set.of_list text.hash (/.reserved archive))))) - (try.else false))) - (_.cover [/.reservations] - (|> (do try.monad - [[@module/0 archive] (/.reserve module/0 /.empty) - [@module/1 archive] (/.reserve module/1 archive) - .let [hash (product.hash text.hash n.hash)]] - (in (set#= (set.of_list hash (list [module/0 @module/0] [module/1 @module/1])) - (set.of_list hash (/.reservations archive))))) - (try.else false))) - (_.cover [/.module_has_already_been_reserved] - (|> (do try.monad - [[@module/0 archive] (/.reserve module/0 /.empty) - _ (/.reserve module/0 archive)] - (in false)) - (exception.otherwise (exception.match? /.module_has_already_been_reserved)))) - (_.cover [/.reserved?] - (|> (do try.monad - [[@module/0 archive] (/.reserve module/0 /.empty)] - (in (and (/.reserved? archive module/0) - (not (/.reserved? archive module/1))))) - (try.else false))) + (_.coverage [/.empty] + (list.empty? (/.entries /.empty))) + (_.coverage [/.reserve /.id] + (|> (do try.monad + [[@module/0 archive] (/.reserve module/0 /.empty) + [@module/1 archive] (/.reserve module/1 archive) + @module/0' (/.id module/0 archive) + @module/1' (/.id module/1 archive)] + (in (and (same? @module/0 @module/0') + (same? @module/1 @module/1')))) + (try.else false))) + (_.coverage [/.reserved] + (|> (do try.monad + [[@module/0 archive] (/.reserve module/0 /.empty) + [@module/1 archive] (/.reserve module/1 archive)] + (in (set#= (set.of_list text.hash (list module/0 module/1)) + (set.of_list text.hash (/.reserved archive))))) + (try.else false))) + (_.coverage [/.reservations] + (|> (do try.monad + [[@module/0 archive] (/.reserve module/0 /.empty) + [@module/1 archive] (/.reserve module/1 archive) + .let [hash (product.hash text.hash n.hash)]] + (in (set#= (set.of_list hash (list [module/0 @module/0] [module/1 @module/1])) + (set.of_list hash (/.reservations archive))))) + (try.else false))) + (_.coverage [/.module_has_already_been_reserved] + (|> (do try.monad + [[@module/0 archive] (/.reserve module/0 /.empty) + _ (/.reserve module/0 archive)] + (in false)) + (exception.otherwise (exception.match? /.module_has_already_been_reserved)))) + (_.coverage [/.reserved?] + (|> (do try.monad + [[@module/0 archive] (/.reserve module/0 /.empty)] + (in (and (/.reserved? archive module/0) + (not (/.reserved? archive module/1))))) + (try.else false))) (_.for [/.Entry] ..test|entry) diff --git a/stdlib/source/test/lux/tool/compiler/meta/archive/key.lux b/stdlib/source/test/lux/tool/compiler/meta/archive/key.lux index 5d9457c91..ff80c5289 100644 --- a/stdlib/source/test/lux/tool/compiler/meta/archive/key.lux +++ b/stdlib/source/test/lux/tool/compiler/meta/archive/key.lux @@ -19,9 +19,9 @@ [expected //signature.random document random.nat] (all _.and - (_.cover [/.key /.signature] - (|> document - (/.key expected) - /.signature - (same? expected))) + (_.coverage [/.key /.signature] + (|> document + (/.key expected) + /.signature + (same? expected))) )))) diff --git a/stdlib/source/test/lux/tool/compiler/meta/archive/module.lux b/stdlib/source/test/lux/tool/compiler/meta/archive/module.lux index f86ab62d6..5251a1c86 100644 --- a/stdlib/source/test/lux/tool/compiler/meta/archive/module.lux +++ b/stdlib/source/test/lux/tool/compiler/meta/archive/module.lux @@ -35,8 +35,8 @@ (<| (_.covering /._) (_.for [/.Module]) (all _.and - (_.cover [/.ID /.runtime] - (n.= 0 /.runtime)) + (_.coverage [/.ID /.runtime] + (n.= 0 /.runtime)) /document.test /descriptor.test diff --git a/stdlib/source/test/lux/tool/compiler/meta/archive/module/descriptor.lux b/stdlib/source/test/lux/tool/compiler/meta/archive/module/descriptor.lux index 6de17ec32..446a91717 100644 --- a/stdlib/source/test/lux/tool/compiler/meta/archive/module/descriptor.lux +++ b/stdlib/source/test/lux/tool/compiler/meta/archive/module/descriptor.lux @@ -48,12 +48,12 @@ ($equivalence.spec /.equivalence (..random 1))) (_.for [/.Module] - (_.cover [/.runtime] - (text#= "" /.runtime))) - (_.cover [/.writer /.parser] - (|> expected - (binary.result /.writer) - (<binary>.result /.parser) - (try#each (|>> (# /.equivalence = (has /.#state {.#Cached} expected)))) - (try.else false))) + (_.coverage [/.runtime] + (text#= "" /.runtime))) + (_.coverage [/.writer /.parser] + (|> expected + (binary.result /.writer) + (<binary>.result /.parser) + (try#each (|>> (# /.equivalence = (has /.#state {.#Cached} expected)))) + (try.else false))) ))) diff --git a/stdlib/source/test/lux/tool/compiler/meta/archive/module/document.lux b/stdlib/source/test/lux/tool/compiler/meta/archive/module/document.lux index 182b127f4..289ab40fd 100644 --- a/stdlib/source/test/lux/tool/compiler/meta/archive/module/document.lux +++ b/stdlib/source/test/lux/tool/compiler/meta/archive/module/document.lux @@ -37,62 +37,62 @@ key/1 (/key.key signature/1 0)] expected random.nat] (all _.and - (_.cover [/.document /.content] - (|> expected - (/.document key/0) - (/.content key/0) - (try#each (same? expected)) - (try.else false))) - (_.cover [/.signature] - (|> expected - (/.document key/0) - /.signature - (same? signature/0))) - (_.cover [/.marked?] - (and (|> expected - (/.document key/0) - (/.marked? key/0) - (pipe.case - {try.#Success it} true - {try.#Failure error} false)) - (|> expected - (/.document key/0) - (/.marked? key/1) - (pipe.case - {try.#Success it} false - {try.#Failure error} true)))) - (_.cover [/.invalid_signature] - (and (|> expected - (/.document key/0) - (/.content key/1) - (pipe.case - {try.#Success it} - false - - {try.#Failure error} - (exception.match? /.invalid_signature error))) - (|> expected - (/.document key/0) - (/.marked? key/1) - (pipe.case - {try.#Success it} - false - - {try.#Failure error} - (exception.match? /.invalid_signature error))))) - (_.cover [/.writer /.parser] - (|> expected - (/.document key/0) - (binaryF.result (/.writer binaryF.nat)) - (<binary>.result (/.parser key/0 <binary>.nat)) - (pipe.case - {try.#Success it} - (and (/signature#= signature/0 (/.signature it)) - (|> it - (/.content key/0) - (try#each (nat.= expected)) - (try.else false))) - - {try.#Failure error} - false))) + (_.coverage [/.document /.content] + (|> expected + (/.document key/0) + (/.content key/0) + (try#each (same? expected)) + (try.else false))) + (_.coverage [/.signature] + (|> expected + (/.document key/0) + /.signature + (same? signature/0))) + (_.coverage [/.marked?] + (and (|> expected + (/.document key/0) + (/.marked? key/0) + (pipe.case + {try.#Success it} true + {try.#Failure error} false)) + (|> expected + (/.document key/0) + (/.marked? key/1) + (pipe.case + {try.#Success it} false + {try.#Failure error} true)))) + (_.coverage [/.invalid_signature] + (and (|> expected + (/.document key/0) + (/.content key/1) + (pipe.case + {try.#Success it} + false + + {try.#Failure error} + (exception.match? /.invalid_signature error))) + (|> expected + (/.document key/0) + (/.marked? key/1) + (pipe.case + {try.#Success it} + false + + {try.#Failure error} + (exception.match? /.invalid_signature error))))) + (_.coverage [/.writer /.parser] + (|> expected + (/.document key/0) + (binaryF.result (/.writer binaryF.nat)) + (<binary>.result (/.parser key/0 <binary>.nat)) + (pipe.case + {try.#Success it} + (and (/signature#= signature/0 (/.signature it)) + (|> it + (/.content key/0) + (try#each (nat.= expected)) + (try.else false))) + + {try.#Failure error} + false))) )))) diff --git a/stdlib/source/test/lux/tool/compiler/meta/archive/registry.lux b/stdlib/source/test/lux/tool/compiler/meta/archive/registry.lux index c097d5190..1e8c54fba 100644 --- a/stdlib/source/test/lux/tool/compiler/meta/archive/registry.lux +++ b/stdlib/source/test/lux/tool/compiler/meta/archive/registry.lux @@ -62,54 +62,54 @@ (random.set text.hash expected_amount) (# ! each set.list))] (`` (all _.and - (_.cover [/.empty] - (|> /.empty - /.artifacts - sequence.size - (n.= 0))) - (_.cover [/.resource] - (let [[@it registry] (/.resource mandatory? expected_dependencies /.empty)] - (case (sequence.list (/.artifacts registry)) - (pattern (list [artifact actual_dependencies])) - (and (same? @it (the artifact.#id artifact)) - (same? mandatory? (the artifact.#mandatory? artifact)) - (tagged? category.#Anonymous (the artifact.#category artifact)) - (same? expected_dependencies actual_dependencies)) + (_.coverage [/.empty] + (|> /.empty + /.artifacts + sequence.size + (n.= 0))) + (_.coverage [/.resource] + (let [[@it registry] (/.resource mandatory? expected_dependencies /.empty)] + (case (sequence.list (/.artifacts registry)) + (pattern (list [artifact actual_dependencies])) + (and (same? @it (the artifact.#id artifact)) + (same? mandatory? (the artifact.#mandatory? artifact)) + (tagged? category.#Anonymous (the artifact.#category artifact)) + (same? expected_dependencies actual_dependencies)) - _ - false))) + _ + false))) (~~ (template [<new> <expected>' <query> <tag> <wrong_new> <wrong_expected>'] - [(_.cover [<new> <query>] - (let [<expected> <expected>' - <wrong_expected> <wrong_expected>'] - (and (let [[@it registry] (<new> <expected> mandatory? expected_dependencies /.empty)] - (and (case (<query> registry) - (pattern (list actual_name)) + [(_.coverage [<new> <query>] + (let [<expected> <expected>' + <wrong_expected> <wrong_expected>'] + (and (let [[@it registry] (<new> <expected> mandatory? expected_dependencies /.empty)] + (and (case (<query> registry) + (pattern (list actual_name)) + (same? <expected> actual_name) + + _ + false) + (case (sequence.list (/.artifacts registry)) + (pattern (list [artifact actual_dependencies])) + (and (same? @it (the artifact.#id artifact)) + (same? mandatory? (the artifact.#mandatory? artifact)) + (case (the artifact.#category artifact) + {<tag> actual_name} (same? <expected> actual_name) _ false) - (case (sequence.list (/.artifacts registry)) - (pattern (list [artifact actual_dependencies])) - (and (same? @it (the artifact.#id artifact)) - (same? mandatory? (the artifact.#mandatory? artifact)) - (case (the artifact.#category artifact) - {<tag> actual_name} - (same? <expected> actual_name) - - _ - false) - (same? expected_dependencies actual_dependencies)) + (same? expected_dependencies actual_dependencies)) - _ - false))) - (let [[@it registry] (<wrong_new> <wrong_expected> mandatory? expected_dependencies /.empty)] - (case (<query> registry) - (pattern (list)) - true + _ + false))) + (let [[@it registry] (<wrong_new> <wrong_expected> mandatory? expected_dependencies /.empty)] + (case (<query> registry) + (pattern (list)) + true - _ - false)))))] + _ + false)))))] [/.definition (is category.Definition [expected_name {.#None}]) /.definitions category.#Definition /.analyser expected_name] [/.analyser expected_name /.analysers category.#Analyser /.synthesizer expected_name] @@ -118,63 +118,63 @@ [/.directive expected_name /.directives category.#Directive /.custom expected_name] [/.custom expected_name /.customs category.#Custom /.definition (is category.Definition [expected_name {.#None}])] )) - (_.cover [/.id] - (and (~~ (template [<new> <expected>' <name>] - [(let [<expected> <expected>' - [@expected registry] (<new> <expected> mandatory? expected_dependencies /.empty)] - (|> (/.id (<name> <expected>) registry) - (maybe#each (same? @expected)) - (maybe.else false)))] + (_.coverage [/.id] + (and (~~ (template [<new> <expected>' <name>] + [(let [<expected> <expected>' + [@expected registry] (<new> <expected> mandatory? expected_dependencies /.empty)] + (|> (/.id (<name> <expected>) registry) + (maybe#each (same? @expected)) + (maybe.else false)))] - [/.definition (is category.Definition [expected_name {.#None}]) product.left] - [/.analyser expected_name |>] - [/.synthesizer expected_name |>] - [/.generator expected_name |>] - [/.directive expected_name |>] - [/.custom expected_name |>] - )))) - (_.cover [/.artifacts] - (and (~~ (template [<new> <query> <equivalence> <$>] - [(let [expected/* (list#each <$> expected_names) - [ids registry] (is [(Sequence artifact.ID) /.Registry] - (list#mix (function (_ expected [ids registry]) - (let [[@new registry] (<new> expected mandatory? expected_dependencies registry)] - [(sequence.suffix @new ids) registry])) - [sequence.empty /.empty] - expected/*)) - it (/.artifacts registry)] - (and (n.= expected_amount (sequence.size it)) - (list.every? (function (_ [@it [it dependencies]]) - (same? @it (the artifact.#id it))) - (list.zipped_2 (sequence.list ids) (sequence.list it))) - (# (list.equivalence <equivalence>) = expected/* (<query> registry))))] + [/.definition (is category.Definition [expected_name {.#None}]) product.left] + [/.analyser expected_name |>] + [/.synthesizer expected_name |>] + [/.generator expected_name |>] + [/.directive expected_name |>] + [/.custom expected_name |>] + )))) + (_.coverage [/.artifacts] + (and (~~ (template [<new> <query> <equivalence> <$>] + [(let [expected/* (list#each <$> expected_names) + [ids registry] (is [(Sequence artifact.ID) /.Registry] + (list#mix (function (_ expected [ids registry]) + (let [[@new registry] (<new> expected mandatory? expected_dependencies registry)] + [(sequence.suffix @new ids) registry])) + [sequence.empty /.empty] + expected/*)) + it (/.artifacts registry)] + (and (n.= expected_amount (sequence.size it)) + (list.every? (function (_ [@it [it dependencies]]) + (same? @it (the artifact.#id it))) + (list.zipped_2 (sequence.list ids) (sequence.list it))) + (# (list.equivalence <equivalence>) = expected/* (<query> registry))))] - [/.definition /.definitions category.definition_equivalence (is (-> Text category.Definition) - (function (_ it) - [it {.#None}]))] - [/.analyser /.analysers text.equivalence (|>>)] - [/.synthesizer /.synthesizers text.equivalence (|>>)] - [/.generator /.generators text.equivalence (|>>)] - [/.directive /.directives text.equivalence (|>>)] - [/.custom /.customs text.equivalence (|>>)] - )))) - (_.cover [/.writer /.parser] - (and (~~ (template [<new> <expected>' <name>] - [(let [<expected> <expected>' - [@expected before] (<new> <expected> mandatory? expected_dependencies /.empty)] - (|> before - (binary.result /.writer) - (<binary>.result /.parser) - (try#each (|>> (/.id (<name> <expected>)) - (maybe#each (same? @expected)) - (maybe.else false))) - (try.else false)))] + [/.definition /.definitions category.definition_equivalence (is (-> Text category.Definition) + (function (_ it) + [it {.#None}]))] + [/.analyser /.analysers text.equivalence (|>>)] + [/.synthesizer /.synthesizers text.equivalence (|>>)] + [/.generator /.generators text.equivalence (|>>)] + [/.directive /.directives text.equivalence (|>>)] + [/.custom /.customs text.equivalence (|>>)] + )))) + (_.coverage [/.writer /.parser] + (and (~~ (template [<new> <expected>' <name>] + [(let [<expected> <expected>' + [@expected before] (<new> <expected> mandatory? expected_dependencies /.empty)] + (|> before + (binary.result /.writer) + (<binary>.result /.parser) + (try#each (|>> (/.id (<name> <expected>)) + (maybe#each (same? @expected)) + (maybe.else false))) + (try.else false)))] - [/.definition (is category.Definition [expected_name {.#None}]) product.left] - [/.analyser expected_name |>] - [/.synthesizer expected_name |>] - [/.generator expected_name |>] - [/.directive expected_name |>] - [/.custom expected_name |>] - )))) + [/.definition (is category.Definition [expected_name {.#None}]) product.left] + [/.analyser expected_name |>] + [/.synthesizer expected_name |>] + [/.generator expected_name |>] + [/.directive expected_name |>] + [/.custom expected_name |>] + )))) ))))) diff --git a/stdlib/source/test/lux/tool/compiler/meta/archive/signature.lux b/stdlib/source/test/lux/tool/compiler/meta/archive/signature.lux index 7981c04c1..7321e07da 100644 --- a/stdlib/source/test/lux/tool/compiler/meta/archive/signature.lux +++ b/stdlib/source/test/lux/tool/compiler/meta/archive/signature.lux @@ -42,15 +42,15 @@ (do random.monad [left ..random right ..random] - (_.cover [/.description] - (bit#= (# /.equivalence = left right) - (text#= (/.description left) (/.description right))))) + (_.coverage [/.description] + (bit#= (# /.equivalence = left right) + (text#= (/.description left) (/.description right))))) (do random.monad [expected ..random] - (_.cover [/.writer /.parser] - (|> expected - (binaryF.result /.writer) - (<binary>.result /.parser) - (try#each (# /.equivalence = expected)) - (try.else false)))) + (_.coverage [/.writer /.parser] + (|> expected + (binaryF.result /.writer) + (<binary>.result /.parser) + (try#each (# /.equivalence = expected)) + (try.else false)))) ))) diff --git a/stdlib/source/test/lux/tool/compiler/meta/archive/unit.lux b/stdlib/source/test/lux/tool/compiler/meta/archive/unit.lux index 0bda3ebc3..fedec7da6 100644 --- a/stdlib/source/test/lux/tool/compiler/meta/archive/unit.lux +++ b/stdlib/source/test/lux/tool/compiler/meta/archive/unit.lux @@ -31,6 +31,6 @@ (_.for [/.hash] ($hash.spec /.hash ..random)) - (_.cover [/.none] - (set.empty? /.none)) + (_.coverage [/.none] + (set.empty? /.none)) ))) diff --git a/stdlib/source/test/lux/tool/compiler/meta/cache.lux b/stdlib/source/test/lux/tool/compiler/meta/cache.lux index 41e6a00e9..27e3c1ded 100644 --- a/stdlib/source/test/lux/tool/compiler/meta/cache.lux +++ b/stdlib/source/test/lux/tool/compiler/meta/cache.lux @@ -36,16 +36,16 @@ outcome (/.enable! ! fs context) post/0 (# fs directory? (/.path fs context)) post/1 (/.enabled? fs context)] - (_.cover' [/.path /.enabled? /.enable!] - (and (not pre/0) - (not pre/1) - - (case outcome - {try.#Success _} true - {try.#Failure _} false) - - post/0 - post/1)))) + (_.coverage' [/.path /.enabled? /.enable!] + (and (not pre/0) + (not pre/1) + + (case outcome + {try.#Success _} true + {try.#Failure _} false) + + post/0 + post/1)))) /archive.test /module.test diff --git a/stdlib/source/test/lux/tool/compiler/meta/cache/archive.lux b/stdlib/source/test/lux/tool/compiler/meta/cache/archive.lux index f7be805d6..061dda399 100644 --- a/stdlib/source/test/lux/tool/compiler/meta/cache/archive.lux +++ b/stdlib/source/test/lux/tool/compiler/meta/cache/archive.lux @@ -72,13 +72,13 @@ cached? (/.cache! fs context archive) actual (# fs read (/.descriptor fs context)) post/0 (# fs file? (/.descriptor fs context))] - (_.cover' [/.descriptor /.cache!] - (and (not pre/0) - (|> (do try.monad - [_ enabled? - _ cached?] - actual) - (try#each (binary#= expected)) - (try.else false)) - post/0)))) + (_.coverage' [/.descriptor /.cache!] + (and (not pre/0) + (|> (do try.monad + [_ enabled? + _ cached?] + actual) + (try#each (binary#= expected)) + (try.else false)) + post/0)))) )))) diff --git a/stdlib/source/test/lux/tool/compiler/meta/cache/artifact.lux b/stdlib/source/test/lux/tool/compiler/meta/cache/artifact.lux index b27211525..319a19d7a 100644 --- a/stdlib/source/test/lux/tool/compiler/meta/cache/artifact.lux +++ b/stdlib/source/test/lux/tool/compiler/meta/cache/artifact.lux @@ -41,13 +41,13 @@ write! (/.cache! fs context @module @artifact expected) post (# fs file? (/.path fs context @module @artifact)) read! (/.cache fs context @module @artifact)] - (_.cover' [/.path /.cache! /.cache] - (and (not pre) - (case write! - {try.#Success _} true - {try.#Failure _} false) - post - (case read! - {try.#Success actual} (binary#= expected actual) - {try.#Failure _} false))))) + (_.coverage' [/.path /.cache! /.cache] + (and (not pre) + (case write! + {try.#Success _} true + {try.#Failure _} false) + post + (case read! + {try.#Success actual} (binary#= expected actual) + {try.#Failure _} false))))) )))) diff --git a/stdlib/source/test/lux/tool/compiler/meta/cache/module.lux b/stdlib/source/test/lux/tool/compiler/meta/cache/module.lux index 6605bf05e..7923e4929 100644 --- a/stdlib/source/test/lux/tool/compiler/meta/cache/module.lux +++ b/stdlib/source/test/lux/tool/compiler/meta/cache/module.lux @@ -60,16 +60,16 @@ outcome (/.enable! ! fs context @module) post/0 (# fs directory? (/.path fs context @module)) post/1 (/.enabled? fs context @module)] - (_.cover' [/.path /.enabled? /.enable!] - (and (not pre/0) - (not pre/1) - - (case outcome - {try.#Success _} true - {try.#Failure _} false) - - post/0 - post/1)))) + (_.coverage' [/.path /.enabled? /.enable!] + (and (not pre/0) + (not pre/1) + + (case outcome + {try.#Success _} true + {try.#Failure _} false) + + post/0 + post/1)))) (in (do [! async.monad] [.let [/ "/" fs (file.mock /)] @@ -78,17 +78,17 @@ outcome (/.enable! ! (..bad fs) context @module) post/0 (# fs directory? (/.path fs context @module)) post/1 (/.enabled? fs context @module)] - (_.cover' [/.cannot_enable] - (and (not pre/0) - (not pre/1) - - (case outcome - {try.#Success _} - false - - {try.#Failure error} - (exception.match? /.cannot_enable error)) - - (not post/0) - (not post/1))))) + (_.coverage' [/.cannot_enable] + (and (not pre/0) + (not pre/1) + + (case outcome + {try.#Success _} + false + + {try.#Failure error} + (exception.match? /.cannot_enable error)) + + (not post/0) + (not post/1))))) )))) diff --git a/stdlib/source/test/lux/tool/compiler/meta/cache/purge.lux b/stdlib/source/test/lux/tool/compiler/meta/cache/purge.lux index d84c092e3..419b247c1 100644 --- a/stdlib/source/test/lux/tool/compiler/meta/cache/purge.lux +++ b/stdlib/source/test/lux/tool/compiler/meta/cache/purge.lux @@ -67,53 +67,53 @@ (all _.and (_.for [/.Cache] (all _.and - (_.cover [/.valid?] - (and (/.valid? descriptor input) - (not (/.valid? descriptor (has ////.#module source_code input))) - (not (/.valid? descriptor (has ////.#file source_code input))) - (not (/.valid? descriptor (revised ////.#hash ++ input))))) + (_.coverage [/.valid?] + (and (/.valid? descriptor input) + (not (/.valid? descriptor (has ////.#module source_code input))) + (not (/.valid? descriptor (has ////.#file source_code input))) + (not (/.valid? descriptor (revised ////.#hash ++ input))))) )) (_.for [/.Purge] (all _.and - (_.cover [/.purge] - (and (dictionary.empty? (/.purge (list) (list))) - (let [order (is (dependency.Order Nat) - (list [name/0 id/0 - [archive.#module module/0 - archive.#output (sequence.sequence) - archive.#registry registry.empty]]))] - (and (let [cache (is (List /.Cache) - (list [#1 name/0 id/0 module/0 registry.empty]))] - (dictionary.empty? (/.purge cache order))) - (let [cache (is (List /.Cache) - (list [#0 name/0 id/0 module/0 registry.empty]))] - (dictionary.key? (/.purge cache order) name/0)))) - (let [order (is (dependency.Order Nat) - (list [name/0 id/0 - [archive.#module module/0 - archive.#output (sequence.sequence) - archive.#registry registry.empty]] - [name/1 id/1 - [archive.#module module/1 - archive.#output (sequence.sequence) - archive.#registry registry.empty]]))] - (and (let [cache (is (List /.Cache) - (list [#1 name/0 id/0 module/0 registry.empty] - [#1 name/1 id/1 module/1 registry.empty])) - purge (/.purge cache order)] - (dictionary.empty? purge)) - (let [cache (is (List /.Cache) - (list [#1 name/0 id/0 module/0 registry.empty] - [#0 name/1 id/1 module/1 registry.empty])) - purge (/.purge cache order)] - (and (not (dictionary.key? (/.purge cache order) name/0)) - (dictionary.key? (/.purge cache order) name/1))) - (let [cache (is (List /.Cache) - (list [#0 name/0 id/0 module/0 registry.empty] - [#1 name/1 id/1 module/1 registry.empty])) - purge (/.purge cache order)] - (and (dictionary.key? (/.purge cache order) name/0) - (dictionary.key? (/.purge cache order) name/1))))))) + (_.coverage [/.purge] + (and (dictionary.empty? (/.purge (list) (list))) + (let [order (is (dependency.Order Nat) + (list [name/0 id/0 + [archive.#module module/0 + archive.#output (sequence.sequence) + archive.#registry registry.empty]]))] + (and (let [cache (is (List /.Cache) + (list [#1 name/0 id/0 module/0 registry.empty]))] + (dictionary.empty? (/.purge cache order))) + (let [cache (is (List /.Cache) + (list [#0 name/0 id/0 module/0 registry.empty]))] + (dictionary.key? (/.purge cache order) name/0)))) + (let [order (is (dependency.Order Nat) + (list [name/0 id/0 + [archive.#module module/0 + archive.#output (sequence.sequence) + archive.#registry registry.empty]] + [name/1 id/1 + [archive.#module module/1 + archive.#output (sequence.sequence) + archive.#registry registry.empty]]))] + (and (let [cache (is (List /.Cache) + (list [#1 name/0 id/0 module/0 registry.empty] + [#1 name/1 id/1 module/1 registry.empty])) + purge (/.purge cache order)] + (dictionary.empty? purge)) + (let [cache (is (List /.Cache) + (list [#1 name/0 id/0 module/0 registry.empty] + [#0 name/1 id/1 module/1 registry.empty])) + purge (/.purge cache order)] + (and (not (dictionary.key? (/.purge cache order) name/0)) + (dictionary.key? (/.purge cache order) name/1))) + (let [cache (is (List /.Cache) + (list [#0 name/0 id/0 module/0 registry.empty] + [#1 name/1 id/1 module/1 registry.empty])) + purge (/.purge cache order)] + (and (dictionary.key? (/.purge cache order) name/0) + (dictionary.key? (/.purge cache order) name/1))))))) (in (do [! async.monad] [_ (//module.enable! ! fs context id/0) .let [dir (//module.path fs context id/0) @@ -124,18 +124,18 @@ pre (# fs directory_files dir) _ (/.purge! fs context id/0) post (# fs directory_files dir)] - (_.cover' [/.purge!] - (<| (try.else false) - (do try.monad - [pre pre] - (in (and (# set.equivalence = - (set.of_list text.hash pre) - (set.of_list text.hash (list file/0 file/1))) - (case post - {try.#Failure error} - (exception.match? file.cannot_find_directory error) + (_.coverage' [/.purge!] + (<| (try.else false) + (do try.monad + [pre pre] + (in (and (# set.equivalence = + (set.of_list text.hash pre) + (set.of_list text.hash (list file/0 file/1))) + (case post + {try.#Failure error} + (exception.match? file.cannot_find_directory error) - success - false)))))))) + success + false)))))))) )) )))) diff --git a/stdlib/source/test/lux/tool/compiler/meta/cli.lux b/stdlib/source/test/lux/tool/compiler/meta/cli.lux index b6eca2b43..657015461 100644 --- a/stdlib/source/test/lux/tool/compiler/meta/cli.lux +++ b/stdlib/source/test/lux/tool/compiler/meta/cli.lux @@ -58,18 +58,18 @@ (_.for [/.Compilation] (`` (all _.and (~~ (template [<type> <slot> <?>] - [(_.cover [<type>] - (|> (partial_list "build" compilation') - (<cli>.result /.service) - (try#each (|>> (pipe.case - {/.#Compilation it} - (|> it - (the <slot>) - <?>) - - _ - false))) - (try.else false)))] + [(_.coverage [<type>] + (|> (partial_list "build" compilation') + (<cli>.result /.service) + (try#each (|>> (pipe.case + {/.#Compilation it} + (|> it + (the <slot>) + <?>) + + _ + false))) + (try.else false)))] [/.Host_Dependency /.#host_dependencies (list#= host_dependencies)] [/.Library /.#libraries (list#= libraries)] @@ -80,65 +80,65 @@ [configuration.Configuration /.#configuration (configuration#= configuration)] )) ))) - (_.cover [/.Interpretation] - (`` (and (~~ (template [<slot> <?>] - [(|> (partial_list "repl" compilation') - (<cli>.result /.service) - (try#each (|>> (pipe.case - {/.#Interpretation it} - (|> it - (the <slot>) - <?>) - - _ - false))) - (try.else false))] + (_.coverage [/.Interpretation] + (`` (and (~~ (template [<slot> <?>] + [(|> (partial_list "repl" compilation') + (<cli>.result /.service) + (try#each (|>> (pipe.case + {/.#Interpretation it} + (|> it + (the <slot>) + <?>) + + _ + false))) + (try.else false))] - [/.#host_dependencies (list#= host_dependencies)] - [/.#libraries (list#= libraries)] - [/.#compilers (# (list.equivalence /compiler.equivalence) = compilers)] - [/.#sources (list#= sources)] - [/.#target (same? target)] - [/.#module (same? module)] - [/.#configuration (configuration#= configuration)] - ))))) - (_.cover [/.Export] - (`` (and (~~ (template [<side> <?>] - [(|> (partial_list "export" export) - (<cli>.result /.service) - (try#each (|>> (pipe.case - {/.#Export it} - (|> it - <side> - <?>) - - _ - false))) - (try.else false))] + [/.#host_dependencies (list#= host_dependencies)] + [/.#libraries (list#= libraries)] + [/.#compilers (# (list.equivalence /compiler.equivalence) = compilers)] + [/.#sources (list#= sources)] + [/.#target (same? target)] + [/.#module (same? module)] + [/.#configuration (configuration#= configuration)] + ))))) + (_.coverage [/.Export] + (`` (and (~~ (template [<side> <?>] + [(|> (partial_list "export" export) + (<cli>.result /.service) + (try#each (|>> (pipe.case + {/.#Export it} + (|> it + <side> + <?>) + + _ + false))) + (try.else false))] - [product.left (list#= sources)] - [product.right (same? target)] - ))))) - (_.cover [/.target] - (`` (and (~~ (template [<it>] - [(same? target (/.target <it>))] + [product.left (list#= sources)] + [product.right (same? target)] + ))))) + (_.coverage [/.target] + (`` (and (~~ (template [<it>] + [(same? target (/.target <it>))] - [{/.#Compilation [/.#host_dependencies host_dependencies - /.#libraries libraries - /.#compilers compilers - /.#sources sources - /.#target target - /.#module module - /.#configuration configuration]}] - [{/.#Interpretation [/.#host_dependencies host_dependencies - /.#libraries libraries - /.#compilers compilers - /.#sources sources - /.#target target - /.#module module - /.#configuration configuration]}] - [{/.#Export [sources target]}] - ))))) + [{/.#Compilation [/.#host_dependencies host_dependencies + /.#libraries libraries + /.#compilers compilers + /.#sources sources + /.#target target + /.#module module + /.#configuration configuration]}] + [{/.#Interpretation [/.#host_dependencies host_dependencies + /.#libraries libraries + /.#compilers compilers + /.#sources sources + /.#target target + /.#module module + /.#configuration configuration]}] + [{/.#Export [sources target]}] + ))))) $/compiler.test )))) diff --git a/stdlib/source/test/lux/tool/compiler/meta/cli/compiler.lux b/stdlib/source/test/lux/tool/compiler/meta/cli/compiler.lux index f9048293b..accb94da5 100644 --- a/stdlib/source/test/lux/tool/compiler/meta/cli/compiler.lux +++ b/stdlib/source/test/lux/tool/compiler/meta/cli/compiler.lux @@ -39,10 +39,10 @@ (_.for [/.equivalence] ($equivalence.spec /.equivalence ..random)) - (_.cover [/.format /.parser] - (|> expected - /.format - (<text>.result /.parser) - (try#each (# /.equivalence = expected)) - (try.else false))) + (_.coverage [/.format /.parser] + (|> expected + /.format + (<text>.result /.parser) + (try#each (# /.equivalence = expected)) + (try.else false))) )))) diff --git a/stdlib/source/test/lux/tool/compiler/meta/context.lux b/stdlib/source/test/lux/tool/compiler/meta/context.lux index 0641b4bcd..954f34791 100644 --- a/stdlib/source/test/lux/tool/compiler/meta/context.lux +++ b/stdlib/source/test/lux/tool/compiler/meta/context.lux @@ -34,23 +34,23 @@ (do [! random.monad] [target (random.lower_case 1)] (all _.and - (_.cover [/.js /.jvm /.lua /.python /.ruby] - (let [contexts (list (/.js target) - (/.jvm target) - (/.lua target) - (/.python target) - (/.ruby target)) - maximum (list.size contexts)] - (`` (and (~~ (template [<amount> <slot>] - [(|> contexts - (list#each (the <slot>)) - (set.of_list text.hash) - set.size - (n.= <amount>))] + (_.coverage [/.js /.jvm /.lua /.python /.ruby] + (let [contexts (list (/.js target) + (/.jvm target) + (/.lua target) + (/.python target) + (/.ruby target)) + maximum (list.size contexts)] + (`` (and (~~ (template [<amount> <slot>] + [(|> contexts + (list#each (the <slot>)) + (set.of_list text.hash) + set.size + (n.= <amount>))] - [maximum /.#host] - [maximum /.#host_module_extension] - [maximum /.#artifact_extension] - [1 /.#target] - )))))) + [maximum /.#host] + [maximum /.#host_module_extension] + [maximum /.#artifact_extension] + [1 /.#target] + )))))) )))) diff --git a/stdlib/source/test/lux/tool/compiler/meta/export.lux b/stdlib/source/test/lux/tool/compiler/meta/export.lux index 46f139850..c2fb768b2 100644 --- a/stdlib/source/test/lux/tool/compiler/meta/export.lux +++ b/stdlib/source/test/lux/tool/compiler/meta/export.lux @@ -75,47 +75,47 @@ export_tar (# ! in (<binary>.result tar.parser export_tar))] (in [library_tar export_tar]))] (all _.and' - (_.cover' [/.library /.mode /.ownership] - (|> it - (try#each (|>> product.left - sequence.list - (pipe.case - (pattern (list {tar.#Normal [actual_path/0 when/0 mode/0 ownership/0 actual_content/0]} - {tar.#Normal [actual_path/1 when/1 mode/1 ownership/1 actual_content/1]})) - (with_expansions [<test> (and (and (text#= file/0' (tar.from_path actual_path/0)) - (same? /.mode mode/0) - (same? /.ownership ownership/0) - (binary#= content/0 (tar.data actual_content/0))) - (and (text#= file/1' (tar.from_path actual_path/1)) - (same? /.mode mode/1) - (same? /.ownership ownership/1) - (binary#= content/1 (tar.data actual_content/1))))] - (or <test> - (let [[[actual_path/0 actual_content/0] [actual_path/1 actual_content/1]] - [[actual_path/1 actual_content/1] [actual_path/0 actual_content/0]]] - <test>))) - - _ - false))) - (try.else false))) - (_.cover' [/.export /.file] - (|> it - (try#each (|>> product.right - sequence.list - (pipe.case - (pattern (list {tar.#Normal [actual_path/0 _ _ _ actual_content/0]} - {tar.#Normal [actual_path/1 _ _ _ actual_content/1]})) - (with_expansions [<test> (and (and (text#= file/0' (tar.from_path actual_path/0)) - (binary#= content/0 (tar.data actual_content/0))) - (and (text#= file/1' (tar.from_path actual_path/1)) - (binary#= content/1 (tar.data actual_content/1))))] - (or <test> - (let [[[actual_path/0 actual_content/0] [actual_path/1 actual_content/1]] - [[actual_path/1 actual_content/1] [actual_path/0 actual_content/0]]] - <test>))) - - _ - false))) - (try.else false))) + (_.coverage' [/.library /.mode /.ownership] + (|> it + (try#each (|>> product.left + sequence.list + (pipe.case + (pattern (list {tar.#Normal [actual_path/0 when/0 mode/0 ownership/0 actual_content/0]} + {tar.#Normal [actual_path/1 when/1 mode/1 ownership/1 actual_content/1]})) + (with_expansions [<test> (and (and (text#= file/0' (tar.from_path actual_path/0)) + (same? /.mode mode/0) + (same? /.ownership ownership/0) + (binary#= content/0 (tar.data actual_content/0))) + (and (text#= file/1' (tar.from_path actual_path/1)) + (same? /.mode mode/1) + (same? /.ownership ownership/1) + (binary#= content/1 (tar.data actual_content/1))))] + (or <test> + (let [[[actual_path/0 actual_content/0] [actual_path/1 actual_content/1]] + [[actual_path/1 actual_content/1] [actual_path/0 actual_content/0]]] + <test>))) + + _ + false))) + (try.else false))) + (_.coverage' [/.export /.file] + (|> it + (try#each (|>> product.right + sequence.list + (pipe.case + (pattern (list {tar.#Normal [actual_path/0 _ _ _ actual_content/0]} + {tar.#Normal [actual_path/1 _ _ _ actual_content/1]})) + (with_expansions [<test> (and (and (text#= file/0' (tar.from_path actual_path/0)) + (binary#= content/0 (tar.data actual_content/0))) + (and (text#= file/1' (tar.from_path actual_path/1)) + (binary#= content/1 (tar.data actual_content/1))))] + (or <test> + (let [[[actual_path/0 actual_content/0] [actual_path/1 actual_content/1]] + [[actual_path/1 actual_content/1] [actual_path/0 actual_content/0]]] + <test>))) + + _ + false))) + (try.else false))) ))) )))) diff --git a/stdlib/source/test/lux/tool/compiler/meta/import.lux b/stdlib/source/test/lux/tool/compiler/meta/import.lux index a0710729f..1c59ed494 100644 --- a/stdlib/source/test/lux/tool/compiler/meta/import.lux +++ b/stdlib/source/test/lux/tool/compiler/meta/import.lux @@ -119,21 +119,21 @@ _ (# fs write library/0 library_content/0) _ (# fs write library/1 library_content/1)] (/.import fs (list library/0 library/1)))] - (_.cover' [/.import] - (and (|> it/0 - (try#each imported?) - (try.else false)) - (|> it/1 - (try#each imported?) - (try.else false)))))) + (_.coverage' [/.import] + (and (|> it/0 + (try#each imported?) + (try.else false)) + (|> it/1 + (try#each imported?) + (try.else false)))))) (in (do [! async.monad] [it (do (try.with !) [.let [fs (file.mock /)] _ (# fs write library/0 library_content) _ (/.import fs (list library/0 library/0))] (in false))] - (_.cover' [/.duplicate] - (exception.otherwise (exception.match? /.duplicate) it)))) + (_.coverage' [/.duplicate] + (exception.otherwise (exception.match? /.duplicate) it)))) (in (do [! async.monad] [it/0 (do (try.with !) [.let [fs (file.mock /)] @@ -150,8 +150,8 @@ _ (# fs write library/0 library_content/-2) _ (/.import fs (list library/0))] (in false))] - (_.cover' [/.useless_tar_entry] - (and (exception.otherwise (exception.match? /.useless_tar_entry) it/0) - (exception.otherwise (exception.match? /.useless_tar_entry) it/1) - (exception.otherwise (exception.match? /.useless_tar_entry) it/2))))) + (_.coverage' [/.useless_tar_entry] + (and (exception.otherwise (exception.match? /.useless_tar_entry) it/0) + (exception.otherwise (exception.match? /.useless_tar_entry) it/1) + (exception.otherwise (exception.match? /.useless_tar_entry) it/2))))) )))) diff --git a/stdlib/source/test/lux/tool/compiler/phase.lux b/stdlib/source/test/lux/tool/compiler/phase.lux index 26217bc46..dd956f90f 100644 --- a/stdlib/source/test/lux/tool/compiler/phase.lux +++ b/stdlib/source/test/lux/tool/compiler/phase.lux @@ -51,49 +51,49 @@ expected random.int expected_error (random.lower_case 1)] (all _.and - (_.cover [/.failure] - (|> (/.failure expected_error) - (/.result state) - (pipe.case {try.#Failure actual_error} - (same? expected_error actual_error) - - _ - false))) - (_.cover [/.lifted] - (and (|> (/.lifted {try.#Failure expected_error}) - (/.result state) - (pipe.case {try.#Failure actual_error} - (same? expected_error actual_error) - - _ - false)) - (|> (/.lifted {try.#Success expected}) - (# /.functor each (same? expected)) - (/.result state) - (try.else false)))) - (_.cover [/.except] - (|> (/.except ..oops []) - (/.result state) - (pipe.case {try.#Failure error} - (exception.match? ..oops error) - - _ - false))) - (_.cover [/.assertion] - (and (|> (/.assertion ..oops [] false) - (/.result state) - (pipe.case {try.#Failure error} - (exception.match? ..oops error) - - _ - false)) - (|> (/.assertion ..oops [] true) - (/.result state) - (pipe.case {try.#Success _} - true - - _ - false)))) + (_.coverage [/.failure] + (|> (/.failure expected_error) + (/.result state) + (pipe.case {try.#Failure actual_error} + (same? expected_error actual_error) + + _ + false))) + (_.coverage [/.lifted] + (and (|> (/.lifted {try.#Failure expected_error}) + (/.result state) + (pipe.case {try.#Failure actual_error} + (same? expected_error actual_error) + + _ + false)) + (|> (/.lifted {try.#Success expected}) + (# /.functor each (same? expected)) + (/.result state) + (try.else false)))) + (_.coverage [/.except] + (|> (/.except ..oops []) + (/.result state) + (pipe.case {try.#Failure error} + (exception.match? ..oops error) + + _ + false))) + (_.coverage [/.assertion] + (and (|> (/.assertion ..oops [] false) + (/.result state) + (pipe.case {try.#Failure error} + (exception.match? ..oops error) + + _ + false)) + (|> (/.assertion ..oops [] true) + (/.result state) + (pipe.case {try.#Success _} + true + + _ + false)))) ))) (def: test|state @@ -103,34 +103,34 @@ dummy random.nat expected random.int] (all _.and - (_.cover [/.state] - (|> /.state - (# /.functor each (same? state)) - (/.result state) - (try.else false))) - (_.cover [/.with] - (|> (do /.monad - [_ (/.with state)] - /.state) - (# /.functor each (same? state)) - (/.result dummy) - (try.else false))) - (_.cover [/.sub] - (|> (/.sub [(# n.hex encoded) - (function (_ new old) - (|> new (# n.hex decoded) (try.else dummy)))] - (do /.monad - [state/hex /.state] - (in (|> state - (# n.hex encoded) - (text#= state/hex))))) - (/.result' state) - (pipe.case {try.#Success [state' verdict]} - (and verdict - (n.= state state')) - - _ - false))) + (_.coverage [/.state] + (|> /.state + (# /.functor each (same? state)) + (/.result state) + (try.else false))) + (_.coverage [/.with] + (|> (do /.monad + [_ (/.with state)] + /.state) + (# /.functor each (same? state)) + (/.result dummy) + (try.else false))) + (_.coverage [/.sub] + (|> (/.sub [(# n.hex encoded) + (function (_ new old) + (|> new (# n.hex decoded) (try.else dummy)))] + (do /.monad + [state/hex /.state] + (in (|> state + (# n.hex encoded) + (text#= state/hex))))) + (/.result' state) + (pipe.case {try.#Success [state' verdict]} + (and verdict + (n.= state state')) + + _ + false))) ))) (def: test|operation @@ -144,23 +144,23 @@ (_.for [/.monad] ($monad.spec ..injection (..comparison state) /.monad)) - (_.cover [/.result] - (|> (# /.monad in expected) - (/.result state) - (pipe.case {try.#Success actual} - (same? expected actual) - - _ - false))) - (_.cover [/.result'] - (|> (# /.monad in expected) - (/.result' state) - (pipe.case {try.#Success [state' actual]} - (and (same? state state') - (same? expected actual)) - - _ - false))) + (_.coverage [/.result] + (|> (# /.monad in expected) + (/.result state) + (pipe.case {try.#Success actual} + (same? expected actual) + + _ + false))) + (_.coverage [/.result'] + (|> (# /.monad in expected) + (/.result' state) + (pipe.case {try.#Success [state' actual]} + (and (same? state state') + (same? expected actual)) + + _ + false))) ..test|state ..test|error ))) @@ -172,27 +172,27 @@ state/1 random.rev expected random.int] (all _.and - (_.cover [/.identity] - (|> (/.identity archive.empty expected) - (/.result state/0) - (try#each (same? expected)) - (try.else false))) - (_.cover [/.composite] - (let [phase (/.composite (is (/.Phase Nat Int Frac) - (function (_ archive input) - (# /.monad in (i.frac input)))) - (is (/.Phase Rev Frac Text) - (function (_ archive input) - (# /.monad in (%.frac input)))))] - (|> (phase archive.empty expected) - (/.result' [state/0 state/1]) - (pipe.case {try.#Success [[state/0' state/1'] actual]} - (and (text#= (%.frac (i.frac expected)) actual) - (same? state/0 state/0') - (same? state/1 state/1')) - - _ - false)))) + (_.coverage [/.identity] + (|> (/.identity archive.empty expected) + (/.result state/0) + (try#each (same? expected)) + (try.else false))) + (_.coverage [/.composite] + (let [phase (/.composite (is (/.Phase Nat Int Frac) + (function (_ archive input) + (# /.monad in (i.frac input)))) + (is (/.Phase Rev Frac Text) + (function (_ archive input) + (# /.monad in (%.frac input)))))] + (|> (phase archive.empty expected) + (/.result' [state/0 state/1]) + (pipe.case {try.#Success [[state/0' state/1'] actual]} + (and (text#= (%.frac (i.frac expected)) actual) + (same? state/0 state/0') + (same? state/1 state/1')) + + _ + false)))) ))) (def: .public test diff --git a/stdlib/source/test/lux/tool/compiler/reference.lux b/stdlib/source/test/lux/tool/compiler/reference.lux index 337baa5ee..e29fc64bf 100644 --- a/stdlib/source/test/lux/tool/compiler/reference.lux +++ b/stdlib/source/test/lux/tool/compiler/reference.lux @@ -50,46 +50,46 @@ ($hash.spec /.hash ..random)) (~~ (template [<tag>] - [(_.cover [<tag>] - (case (<tag> expected_register) - (pattern (<tag> actual_register)) - (n.= expected_register actual_register) + [(_.coverage [<tag>] + (case (<tag> expected_register) + (pattern (<tag> actual_register)) + (n.= expected_register actual_register) - _ - false))] + _ + false))] [/.local] [/.foreign] )) - (_.cover [/.variable /.self] - (and (# /.equivalence = (/.self) (/.variable (variable.self))) - (case (/.self) - (pattern (/.self)) - true - - _ - false) - (case (/.variable (variable.self)) - (pattern (/.self)) - true - - _ - false))) - (_.cover [/.constant] - (case (/.constant expected_constant) - (pattern (/.constant actual_constant)) - (symbol#= expected_constant actual_constant) + (_.coverage [/.variable /.self] + (and (# /.equivalence = (/.self) (/.variable (variable.self))) + (case (/.self) + (pattern (/.self)) + true + + _ + false) + (case (/.variable (variable.self)) + (pattern (/.self)) + true + + _ + false))) + (_.coverage [/.constant] + (case (/.constant expected_constant) + (pattern (/.constant actual_constant)) + (symbol#= expected_constant actual_constant) - _ - false)) - (_.cover [/.format] - (and (text#= (/.format (/.local expected_register)) - (variable.format {variable.#Local expected_register})) - (text#= (/.format (/.foreign expected_register)) - (variable.format {variable.#Foreign expected_register})) - (text#= (/.format (/.constant expected_constant)) - (%.symbol expected_constant)))) + _ + false)) + (_.coverage [/.format] + (and (text#= (/.format (/.local expected_register)) + (variable.format {variable.#Local expected_register})) + (text#= (/.format (/.foreign expected_register)) + (variable.format {variable.#Foreign expected_register})) + (text#= (/.format (/.constant expected_constant)) + (%.symbol expected_constant)))) /variable.test )))) diff --git a/stdlib/source/test/lux/tool/compiler/reference/variable.lux b/stdlib/source/test/lux/tool/compiler/reference/variable.lux index d88aa2c56..69db9b255 100644 --- a/stdlib/source/test/lux/tool/compiler/reference/variable.lux +++ b/stdlib/source/test/lux/tool/compiler/reference/variable.lux @@ -32,14 +32,14 @@ ($equivalence.spec /.equivalence ..random)) (_.for [/.hash] ($hash.spec /.hash ..random)) - (_.cover [/.self] - (case (/.self) - (pattern (/.self)) true - _ false)) - (_.cover [/.self?] - (/.self? (/.self))) + (_.coverage [/.self] + (case (/.self) + (pattern (/.self)) true + _ false)) + (_.coverage [/.self?] + (/.self? (/.self))) (_.for [/.Register] - (_.cover [/.format] - (not (text#= (/.format {/.#Local register}) - (/.format {/.#Foreign register}))))) + (_.coverage [/.format] + (not (text#= (/.format {/.#Local register}) + (/.format {/.#Foreign register}))))) )))) diff --git a/stdlib/source/test/lux/tool/compiler/version.lux b/stdlib/source/test/lux/tool/compiler/version.lux index 492b02fa7..f76f8651d 100644 --- a/stdlib/source/test/lux/tool/compiler/version.lux +++ b/stdlib/source/test/lux/tool/compiler/version.lux @@ -27,13 +27,13 @@ [this ..random that ..random] (`` (all _.and - (_.cover [/.format] - (bit#= (n.= this that) - (text#= (/.format this) (/.format that)))) + (_.coverage [/.format] + (bit#= (n.= this that) + (text#= (/.format this) (/.format that)))) (~~ (template [<level>] - [(_.cover [<level>] - (text.contains? (%.nat (<level> this)) - (/.format this)))] + [(_.coverage [<level>] + (text.contains? (%.nat (<level> this)) + (/.format this)))] [/.patch] [/.minor] |