diff options
Diffstat (limited to 'stdlib/source/test/lux/tool/compiler')
18 files changed, 681 insertions, 681 deletions
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 dfd65e1ba..629ffb39f 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 @@ -285,28 +285,28 @@ composes_variants! (let [composes_different_variants! - (let [composes? (: (-> (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))))] + (let [composes? (is (-> (Maybe Nat) (Maybe Nat) (Maybe Nat) Bit) + (function (_ left right both) + (|> (/.composite {/.#Variant left (dictionary.of_list n.hash (list [tag/0 expected/0]))} + {/.#Variant right (dictionary.of_list n.hash (list [tag/1 expected/1]))}) + (try#each (/#= {/.#Variant both (dictionary.of_list n.hash (list [tag/0 expected/0] + [tag/1 expected/1]))})) + (try.else false))))] (and (composes? {.#None} {.#None} {.#None}) (composes? {.#Some arity} {.#None} {.#Some arity}) (composes? {.#None} {.#Some arity} {.#Some arity}) (composes? {.#Some arity} {.#Some arity} {.#Some arity}))) composes_same_variants! - (let [composes? (: (-> (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))))] + (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}) 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 aa9f91e78..af26cf21c 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 @@ -232,29 +232,29 @@ [tagT tagC] (|> types/*,terms/* (list.item tag) (maybe.else [Any (' [])])) - variant?' (: (-> 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? (: (-> Type Nat Bit Code Bit) - (function (_ type lefts right? term) - (variant?' type {.#Some type} lefts right? term))) + 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) @@ -332,26 +332,26 @@ [type/1 term/1] (random.only (|>> product.left (same? type/0) not) ..simple_parameter) types/*,terms/* (random.list arity ..simple_parameter) - .let [record? (: (-> Type (Maybe Type) Nat (List Code) Bit) - (function (_ record expected arity terms) - (|> (do /phase.monad - [inference (/.record arity record) - [_ [it _]] (|> (/.general archive.empty ..analysis inference terms) - //type.inferring)] - (case expected - {.#Some expected} - (//type.check - (do check.monad - [_ (check.check expected it) - _ (check.check it expected)] - (in true))) - - {.#None} - (in true))) - (//module.with 0 (product.left name)) - (/phase#each product.right) - (/phase.result state) - (try.else false)))) + .let [record? (is (-> Type (Maybe Type) Nat (List Code) Bit) + (function (_ record expected arity terms) + (|> (do /phase.monad + [inference (/.record arity record) + [_ [it _]] (|> (/.general archive.empty ..analysis inference terms) + //type.inferring)] + (case expected + {.#Some expected} + (//type.check + (do check.monad + [_ (check.check expected it) + _ (check.check it expected)] + (in true))) + + {.#None} + (in true))) + (//module.with 0 (product.left name)) + (/phase#each product.right) + (/phase.result state) + (try.else false)))) record (type.tuple (list#each product.left types/*,terms/*)) terms (list#each product.right types/*,terms/*)]] ($_ _.and 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 af025cb4d..a7fe6be62 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 @@ -62,8 +62,8 @@ poly (random.list multiplicity $code.random) lux ..random_state - .let [singular (<| (:as Macro) - (: Macro') + .let [singular (<| (as Macro) + (is Macro') (function (_ inputs state) (case (list.item choice inputs) {.#Some it} @@ -71,8 +71,8 @@ {.#None} {try.#Failure expected_error}))) - multiple (<| (:as Macro) - (: Macro') + multiple (<| (as Macro) + (is Macro') (function (_ inputs state) {try.#Success [state (|> inputs (list.repeated multiplicity) 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 5fa0d281b..7a36cce34 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 @@ -68,20 +68,20 @@ $binding/2 (# ! each code.local_symbol (random.ascii/lower 5))] ($_ _.and (_.cover [/.tuple] - (let [tuple? (: (-> 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)))))] + (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) @@ -144,17 +144,17 @@ (-> Lux Symbol [Type Code] [Type Code] [Type Code] [Code Code Code] [Type Code] [Type Code] [Bit Nat] Bit) (let [state [//extension.#bundle (//extension/analysis.bundle ..eval) //extension.#state lux] - case? (: (-> Code (List [Code Code]) Bit) - (function (_ input branches) - (|> (do //phase.monad - [analysis (|> (/.case ..analysis branches archive.empty input) - (//type.expecting output/0))] - (in true)) - //scope.with - (//module.with 0 module/0) - (//phase#each (|>> product.right product.right)) - (//phase.result state) - (try.else false)))) + case? (is (-> Code (List [Code Code]) Bit) + (function (_ input branches) + (|> (do //phase.monad + [analysis (|> (/.case ..analysis branches archive.empty input) + (//type.expecting output/0))] + (in true)) + //scope.with + (//module.with 0 module/0) + (//phase#each (|>> product.right product.right)) + (//phase.result state) + (try.else false)))) body_types_mismatch! (and (not (case? (code.bit bit/0) (list [(` #0) body/1] @@ -251,17 +251,17 @@ (-> Lux Symbol [Type Code] [Type Code] [Type Code] [Code Code Code] [Type Code] Bit Bit) (let [state [//extension.#bundle (//extension/analysis.bundle ..eval) //extension.#state lux] - redundant? (: (-> Code (List [Code Code]) Bit) - (function (_ input branches) - (|> (do //phase.monad - [analysis (|> (/.case ..analysis branches archive.empty input) - (//type.expecting output/0))] - (in true)) - //scope.with - (//module.with 0 module/0) - (//phase#each (|>> product.right product.right)) - (//phase.result state) - (exception.otherwise (text.contains? (the exception.#label //coverage.redundancy))))))] + redundant? (is (-> Code (List [Code Code]) Bit) + (function (_ input branches) + (|> (do //phase.monad + [analysis (|> (/.case ..analysis branches archive.empty input) + (//type.expecting output/0))] + (in true)) + //scope.with + (//module.with 0 module/0) + (//phase#each (|>> product.right product.right)) + (//phase.result state) + (exception.otherwise (text.contains? (the exception.#label //coverage.redundancy))))))] (and (redundant? (` []) (list [(` []) body/0] [(` []) body/0])) @@ -313,18 +313,18 @@ tag/1 (code.symbol [module/0 tag/1]) tag/2 (code.symbol [module/0 tag/2]) - variant? (: (-> Code (List [Code Code]) Bit) - (function (_ input branches) - (|> (do //phase.monad - [_ (//module.declare_labels false tags/* false :variant:) - analysis (|> (/.case ..analysis branches archive.empty input) - (//type.expecting output/0))] - (in true)) - //scope.with - (//module.with 0 module/0) - (//phase#each (|>> product.right product.right)) - (//phase.result state) - (try.else false)))) + variant? (is (-> Code (List [Code Code]) Bit) + (function (_ input branches) + (|> (do //phase.monad + [_ (//module.declare_labels false tags/* false :variant:) + analysis (|> (/.case ..analysis branches archive.empty input) + (//type.expecting output/0))] + (in true)) + //scope.with + (//module.with 0 module/0) + (//phase#each (|>> product.right product.right)) + (//phase.result state) + (try.else false)))) can_bind! (and (variant? (` {(~ tag/0) (~ simple/0)}) @@ -384,18 +384,18 @@ slot/1 (code.symbol [module/0 slot/1]) slot/2 (code.symbol [module/0 slot/2]) - record? (: (-> Code (List [Code Code]) Bit) - (function (_ input branches) - (|> (do //phase.monad - [_ (//module.declare_labels true slots/* false :record:) - analysis (|> (/.case ..analysis branches archive.empty input) - (//type.expecting output/0))] - (in true)) - //scope.with - (//module.with 0 module/0) - (//phase#each (|>> product.right product.right)) - (//phase.result state) - (try.else false)))) + record? (is (-> Code (List [Code Code]) Bit) + (function (_ input branches) + (|> (do //phase.monad + [_ (//module.declare_labels true slots/* false :record:) + analysis (|> (/.case ..analysis branches archive.empty input) + (//type.expecting output/0))] + (in true)) + //scope.with + (//module.with 0 module/0) + (//phase#each (|>> product.right product.right)) + (//phase.result state) + (try.else false)))) can_bind! (record? (` [(~ slot/0) (~ simple/0) @@ -531,32 +531,32 @@ (//phase.result state) (exception.otherwise (text.contains? (the exception.#label /.empty_branches))))) (_.cover [/.non_exhaustive] - (let [non_exhaustive? (: (-> (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))))))] + (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? (: (-> (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))))))] + (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)}) 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 f6d69fc56..aa0a98c6b 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 @@ -144,23 +144,23 @@ ($_ _.and (_.cover [/.sum] (let [variantT (type.variant (list#each product.left types/*,terms/*)) - sum? (: (-> 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))))] + 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 @@ -187,11 +187,11 @@ (and (sum? (type (Ex (_ a) (Maybe a))) 0 #0 (` [])) (sum? (type (Ex (_ a) (Maybe a))) 0 #1 tagC))))) (_.for [/.cannot_analyse_variant] - (let [failure? (: (All (_ a) (-> (Exception a) (//analysis.Operation Any) Bit)) - (function (_ exception analysis) - (let [it (//phase.result state analysis)] - (and (..failure? /.cannot_analyse_variant it) - (..failure? exception it)))))] + (let [failure? (is (All (_ a) (-> (Exception a) (//analysis.Operation Any) Bit)) + (function (_ exception analysis) + (let [it (//phase.result state analysis)] + (and (..failure? /.cannot_analyse_variant it) + (..failure? exception it)))))] ($_ _.and (_.cover [/.invalid_variant_type] (and (|> (/.sum ..analysis lefts right? archive.empty tagC) @@ -235,43 +235,43 @@ (maybe.else ""))]] ($_ _.and (_.cover [/.variant] - (let [expected_variant? (: (-> 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? (: (-> 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))))] + (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]) @@ -300,26 +300,26 @@ expected (list#each product.right types/*,terms/*)]] ($_ _.and (_.cover [/.product] - (let [product? (: (-> 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))))] + (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)) @@ -408,11 +408,11 @@ (try.else false))))) (_.for [/.cannot_analyse_tuple] (_.cover [/.invalid_tuple_type] - (let [failure? (: (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)))))] + (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/* @@ -472,21 +472,21 @@ slots/0)]] ($_ _.and (_.cover [/.normal] - (let [normal? (: (-> (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))))] + (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) @@ -501,33 +501,33 @@ (_.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? (: (-> 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? (: (-> 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))))] + 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) @@ -544,29 +544,29 @@ ... TODO: Test what happens when slots are shadowed by local bindings. ))) (_.cover [/.cannot_repeat_slot] - (let [repeated? (: (-> 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))))] + (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? (: (-> 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))))] + 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))) @@ -577,47 +577,47 @@ (_.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? (: (-> 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))))] + 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? (: (-> 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? (: (-> (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))))] + (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) 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 fd60e1de8..a770e05e3 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 @@ -82,41 +82,41 @@ $argument/1 (code.local_symbol argument/1)]] ($_ _.and (_.cover [/.function] - (let [function?' (: (-> 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) + (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? (: (-> Type Code Bit) - (function (_ function_type output_term) - (function?' function_type output_term (function.constant true)))) - inferring? (: (-> Type Code Bit) - (function (_ :expected: term) - (|> (do //phase.monad - [[:actual: analysis] (|> (/.function ..analysis function/0 argument/0 archive.empty - term) - //type.inferring)] - (in (case analysis - {//analysis.#Function [actual_env actual_body]} - (type#= :expected: :actual:) + _ + false))) + (//module.with 0 module/0) + (//phase#each product.right) + (//phase.result state) + (try.else false)))) + function? (is (-> Type Code Bit) + (function (_ function_type output_term) + (function?' function_type output_term (function.constant true)))) + inferring? (is (-> Type Code Bit) + (function (_ :expected: term) + (|> (do //phase.monad + [[:actual: analysis] (|> (/.function ..analysis function/0 argument/0 archive.empty + term) + //type.inferring)] + (in (case analysis + {//analysis.#Function [actual_env actual_body]} + (type#= :expected: :actual:) - _ - false))) - (//module.with 0 module/0) - (//phase#each product.right) - (//phase.result state) - (try.else false))))] + _ + 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) @@ -206,26 +206,26 @@ module/0 (random.ascii/lower 1)] ($_ _.and (_.cover [/.apply] - (let [reification? (: (-> 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 + (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))))] + _ + 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) 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 d8c5ce4f8..8240bcddc 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 @@ -168,56 +168,56 @@ can_find_alias! can_find_type!))) (_.cover [/.foreign_module_has_not_been_imported] - (let [scenario (: (-> 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))) - )))] + (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 (: (-> 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))) - )))] + (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 (: (-> 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))))))] + (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 ea5d4ebb4..5827be799 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 @@ -67,14 +67,14 @@ false)))) (template: (analysis? <type> <tag>) - [(: (-> <type> Analysis Bit) - (function (_ expected) - (|>> (pipe.case - (pattern (<tag> actual)) - (same? expected actual) + [(is (-> <type> Analysis Bit) + (function (_ expected) + (|>> (pipe.case + (pattern (<tag> actual)) + (same? expected actual) - _ - false))))]) + _ + false))))]) (def: .public test (<| (_.covering /._) 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 1f24840eb..307816a02 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 @@ -45,48 +45,48 @@ random.int)] ($_ _.and (_.cover [/.read] - (|> (: (/.Operation Int Nat Nat Text) - (/.read %.int)) + (|> (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] - (|> (: (/.Operation Int Nat Nat Text) - (do phase.monad - [_ (/.update ++)] - (/.read %.int))) + (|> (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] - (|> (: (/.Operation Int Nat Nat Text) - (do phase.monad - [|state'| (/.temporary ++ (/.read %.int)) - |state| (/.read %.int)] - (in (format |state'| " " |state|)))) + (|> (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] - (|> (: (/.Operation Int Nat Nat Text) - (/.with_state state - (/.read %.int))) + (|> (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] - (|> (: (/.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|)))) + (|> (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 @@ -96,7 +96,7 @@ (def: extender /.Extender - (|>> :expected)) + (|>> as_expected)) (def: handler/0 (/.Handler Int Nat Nat) @@ -144,9 +144,9 @@ (def: test|bundle Test - (let [phase (: (/.Phase Int Nat Nat) - (function (_ archive input) - (# phase.monad in (++ input))))] + (let [phase (is (/.Phase Int Nat Nat) + (function (_ archive input) + (# phase.monad in (++ input))))] (do [! random.monad] [state random.int @@ -167,12 +167,12 @@ /.#state state]) (try.else false))) (_.cover [/.Phase] - (let [handler (: (/.Handler Int Nat Nat) - (function (_ @self phase archive inputs) - (let [! phase.monad] - (|> inputs - (monad.each ! (phase archive)) - (# ! each (list#mix n.+ 0))))))] + (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)])) @@ -191,9 +191,9 @@ /.#state state]) (try.else false))) (_.cover [/.incorrect_arity] - (let [handler (: (/.Handler Int Nat Nat) - (function (_ @self phase archive inputs) - (phase.except /.incorrect_arity [@self 2 (list.size inputs)])))] + (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)])) @@ -206,9 +206,9 @@ _ false)))) (_.cover [/.invalid_syntax] - (let [handler (: (/.Handler Int Nat Nat) - (function (_ @self phase archive inputs) - (phase.except /.invalid_syntax [@self %.nat inputs])))] + (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)])) @@ -244,16 +244,16 @@ (<| (_.for [/.Operation]) ($_ _.and (_.cover [/.lifted] - (and (|> (: (/.Operation Int Nat Nat Nat) - (/.lifted (do phase.monad - [] - (in expected)))) + (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)) - (|> (: (/.Operation Int Nat Nat Nat) - (/.lifted (phase.lifted {try.#Failure expected_error}))) + (|> (is (/.Operation Int Nat Nat Nat) + (/.lifted (phase.lifted {try.#Failure expected_error}))) (phase.result [/.#bundle /.empty /.#state state]) (pipe.case @@ -266,9 +266,9 @@ (|> (do phase.monad [] (in expected)) - (: (/.Operation Int Nat Nat Nat)) + (is (/.Operation Int Nat Nat Nat)) /.up - (: (phase.Operation Int Nat)) + (is (phase.Operation Int Nat)) (# phase.functor each (same? expected)) (phase.result state) (try.else false))) 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 ea325ec72..aaa52ad0f 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 @@ -87,12 +87,12 @@ inputA //primitive.primitive thenA //primitive.primitive elseA //primitive.primitive - .let [thenB (: Branch - [{analysis.#Simple {analysis.#Bit true}} - thenA]) - elseB (: Branch - [{analysis.#Simple {analysis.#Bit false}} - elseA]) + .let [thenB (is Branch + [{analysis.#Simple {analysis.#Bit true}} + thenA]) + elseB (is Branch + [{analysis.#Simple {analysis.#Bit false}} + elseA]) ifA (if then|else (analysis.case [inputA [thenB (list elseB)]]) (analysis.case [inputA [elseB (list thenB)]]))]] @@ -237,20 +237,20 @@ [value/0 value/1 value/2 value/3 value/4] (random_five text.hash (random.unicode 1)) last_is_right? random.bit [body/0 body/1 body/2 body/3 body/4] (random_five frac.hash random.frac) - .let [path (: (-> Nat Bit Text Frac Path) - (function (_ lefts right? value body) - ($_ {synthesis.#Seq} - (synthesis.path/side (if right? - {.#Right lefts} - {.#Left lefts})) - (synthesis.path/text value) - {synthesis.#Then (synthesis.f64 body)}))) - branch (: (-> Nat Bit Text Frac Branch) - (function (_ lefts right? value body) - [analysis.#when (analysis.pattern/variant [analysis.#lefts lefts - analysis.#right? right? - analysis.#value (analysis.pattern/text value)]) - analysis.#then (analysis.frac body)]))]] + .let [path (is (-> Nat Bit Text Frac Path) + (function (_ lefts right? value body) + ($_ {synthesis.#Seq} + (synthesis.path/side (if right? + {.#Right lefts} + {.#Left lefts})) + (synthesis.path/text value) + {synthesis.#Then (synthesis.f64 body)}))) + branch (is (-> Nat Bit Text Frac Branch) + (function (_ lefts right? value body) + [analysis.#when (analysis.pattern/variant [analysis.#lefts lefts + analysis.#right? right? + analysis.#value (analysis.pattern/text value)]) + analysis.#then (analysis.frac body)]))]] (in [($_ {synthesis.#Alt} (path lefts/0 false value/0 body/0) (path lefts/1 false value/1 body/1) @@ -275,32 +275,32 @@ body/first random.frac body/mid (random.list mid_size random.frac) body/last random.frac - .let [path (: (-> Nat Bit Text Frac Path) - (function (_ lefts right? value body) - (if right? - ($_ {synthesis.#Seq} - (synthesis.path/member (if right? - {.#Right lefts} - {.#Left lefts})) - (synthesis.path/text value) - {synthesis.#Then (synthesis.f64 body)}) - ($_ {synthesis.#Seq} - (synthesis.path/member (if right? - {.#Right lefts} - {.#Left lefts})) - (synthesis.path/text value) - {synthesis.#Pop} - {synthesis.#Then (synthesis.f64 body)})))) - branch (: (-> Nat Bit Text Frac Branch) - (function (_ lefts right? value body) - [analysis.#when (if right? - (analysis.pattern/tuple (list#composite (list.repeated (++ lefts) (analysis.pattern/unit)) - (list (analysis.pattern/text value)))) - (analysis.pattern/tuple ($_ list#composite - (list.repeated lefts (analysis.pattern/unit)) - (list (analysis.pattern/text value) - (analysis.pattern/unit))))) - analysis.#then (analysis.frac body)]))]] + .let [path (is (-> Nat Bit Text Frac Path) + (function (_ lefts right? value body) + (if right? + ($_ {synthesis.#Seq} + (synthesis.path/member (if right? + {.#Right lefts} + {.#Left lefts})) + (synthesis.path/text value) + {synthesis.#Then (synthesis.f64 body)}) + ($_ {synthesis.#Seq} + (synthesis.path/member (if right? + {.#Right lefts} + {.#Left lefts})) + (synthesis.path/text value) + {synthesis.#Pop} + {synthesis.#Then (synthesis.f64 body)})))) + branch (is (-> Nat Bit Text Frac Branch) + (function (_ lefts right? value body) + [analysis.#when (if right? + (analysis.pattern/tuple (list#composite (list.repeated (++ lefts) (analysis.pattern/unit)) + (list (analysis.pattern/text value)))) + (analysis.pattern/tuple ($_ list#composite + (list.repeated lefts (analysis.pattern/unit)) + (list (analysis.pattern/text value) + (analysis.pattern/unit))))) + analysis.#then (analysis.frac body)]))]] (in [(list#mix (function (_ left right) {synthesis.#Alt left right}) (path (++ mid_size) true value/last body/last) 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 1f220e13a..84c3873aa 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 @@ -109,48 +109,48 @@ (def: path (Scenario Path) - (let [pattern (: (Scenario Path) - (.function (again offset arity next) - (`` ($_ random.either - (random#in [next - [//.path/pop - //.path/pop]]) - (~~ (template [<path> <random>] - [(do [! random.monad] - [example (# ! each (|>> <path>) <random>)] - (in [next - [example - example]]))] + (let [pattern (is (Scenario Path) + (.function (again offset arity next) + (`` ($_ random.either + (random#in [next + [//.path/pop + //.path/pop]]) + (~~ (template [<path> <random>] + [(do [! random.monad] + [example (# ! each (|>> <path>) <random>)] + (in [next + [example + example]]))] - [//.path/bit random.bit] - [//.path/i64 (# ! each .i64 random.nat)] - [//.path/f64 random.frac] - [//.path/text (random.unicode 1)] - )) - (~~ (template [<path>] - [(do [! random.monad] - [example (# ! each (|>> <path>) - (random.or random.nat - random.nat))] - (in [next - [example - example]]))] + [//.path/bit random.bit] + [//.path/i64 (# ! each .i64 random.nat)] + [//.path/f64 random.frac] + [//.path/text (random.unicode 1)] + )) + (~~ (template [<path>] + [(do [! random.monad] + [example (# ! each (|>> <path>) + (random.or random.nat + random.nat))] + (in [next + [example + example]]))] - [//.path/side] - [//.path/member] - )) - (random#in [(++ next) - [(//.path/bind (/.register_optimization offset next)) - (//.path/bind next)]]) - )))) - sequential (: (Scenario Path) - (.function (again offset arity next) - (do random.monad - [[next [patternE patternA]] (pattern offset arity next) - [next [bodyE bodyA]] (..reference offset arity next)] - (in [next - [(//.path/seq patternE (//.path/then bodyE)) - (//.path/seq patternA (//.path/then bodyA))]]))))] + [//.path/side] + [//.path/member] + )) + (random#in [(++ next) + [(//.path/bind (/.register_optimization offset next)) + (//.path/bind next)]]) + )))) + sequential (is (Scenario Path) + (.function (again offset arity next) + (do random.monad + [[next [patternE patternA]] (pattern offset arity next) + [next [bodyE bodyA]] (..reference offset arity next)] + (in [next + [(//.path/seq patternE (//.path/then bodyE)) + (//.path/seq patternA (//.path/then bodyA))]]))))] (.function (again offset arity next) (do random.monad [[next [leftE leftA]] (sequential offset arity next) @@ -161,9 +161,9 @@ (def: (branch offset arity next) (Scenario Synthesis) - (let [random_member (: (Random Member) - (random.or random.nat - random.nat))] + (let [random_member (is (Random Member) + (random.or random.nat + random.nat))] ($_ random.either ($_ random.either (do [! random.monad] 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 80499a5e2..2de99cd64 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 @@ -31,15 +31,15 @@ (def: .public primitive (Random Analysis) (do r.monad - [primitive (: (Random ////analysis.Primitive) - ($_ r.or - (in []) - r.bit - r.nat - r.int - r.rev - r.frac - (r.unicode 5)))] + [primitive (is (Random ////analysis.Primitive) + ($_ r.or + (in []) + r.bit + r.nat + r.int + r.rev + r.frac + (r.unicode 5)))] (in {////analysis.#Primitive primitive}))) (def: .public (corresponds? analysis synthesis) @@ -51,7 +51,7 @@ (same? (|> expected <post_analysis>) (|> actual <post_synthesis>))] - [////analysis.#Unit (:as Text) ////synthesis.#Text (|>)] + [////analysis.#Unit (as Text) ////synthesis.#Text (|>)] [////analysis.#Bit (|>) ////synthesis.#Bit (|>)] [////analysis.#Nat .i64 ////synthesis.#I64 .i64] [////analysis.#Int .i64 ////synthesis.#I64 .i64] 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 90d5b825c..c253f7107 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/syntax.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/syntax.lux @@ -1,28 +1,28 @@ (.using - [lux "*" - [abstract/monad {"+" do}] - [data - ["%" text/format {"+" format}] - [number - ["n" nat]]] - ["r" math/random {"+" Random} ("[1]#[0]" monad)] - ["_" test {"+" Test}] - [control - ["[0]" try] - [parser - ["l" text]]] - [data - ["[0]" text] - [collection - ["[0]" list] - ["[0]" dictionary {"+" Dictionary}]]] - [macro - ["[0]" code]] - [meta - ["[0]" location] - ["[0]" symbol]]] - [\\ - ["[0]" /]]) + [lux "*" + [abstract/monad {"+" do}] + [data + ["%" text/format {"+" format}] + [number + ["n" nat]]] + ["r" math/random {"+" Random} ("[1]#[0]" monad)] + ["_" test {"+" Test}] + [control + ["[0]" try] + [parser + ["l" text]]] + [data + ["[0]" text] + [collection + ["[0]" list] + ["[0]" dictionary {"+" Dictionary}]]] + [macro + ["[0]" code]] + [meta + ["[0]" location] + ["[0]" symbol]]] + [\\ + ["[0]" /]]) (def: symbol_part^ (Random Text) @@ -36,37 +36,37 @@ (def: code^ (Random Code) - (let [numeric^ (: (Random Code) + (let [numeric^ (is (Random Code) + ($_ r.either + (|> r.bit (r#each code.bit)) + (|> r.nat (r#each code.nat)) + (|> r.int (r#each code.int)) + (|> r.rev (r#each code.rev)) + (|> r.safe_frac (r#each code.frac)))) + textual^ (is (Random Code) + ($_ r.either + (do r.monad + [size (|> r.nat (r#each (n.% 20)))] + (|> (r.ascii/upper_alpha size) (r#each code.text))) + (|> symbol^ (r#each code.symbol)) + (|> symbol^ (r#each code.tag)))) + simple^ (is (Random Code) ($_ r.either - (|> r.bit (r#each code.bit)) - (|> r.nat (r#each code.nat)) - (|> r.int (r#each code.int)) - (|> r.rev (r#each code.rev)) - (|> r.safe_frac (r#each code.frac)))) - textual^ (: (Random Code) - ($_ r.either - (do r.monad - [size (|> r.nat (r#each (n.% 20)))] - (|> (r.ascii/upper_alpha size) (r#each code.text))) - (|> symbol^ (r#each code.symbol)) - (|> symbol^ (r#each code.tag)))) - simple^ (: (Random Code) - ($_ r.either - numeric^ - textual^))] + numeric^ + textual^))] (r.rec (function (_ code^) (let [multi^ (do r.monad [size (|> r.nat (r#each (n.% 3)))] (r.list size code^)) - composite^ (: (Random Code) - ($_ r.either - (|> multi^ (r#each code.form)) - (|> multi^ (r#each code.tuple)) - (do r.monad - [size (|> r.nat (r#each (n.% 3)))] - (|> (r.list size (r.and code^ code^)) - (r#each code.record)))))] + composite^ (is (Random Code) + ($_ r.either + (|> multi^ (r#each code.form)) + (|> multi^ (r#each code.tuple)) + (do r.monad + [size (|> r.nat (r#each (n.% 3)))] + (|> (r.list size (r.and code^ code^)) + (r#each code.record)))))] ($_ r.either simple^ composite^)))))) 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 e347edf4a..d012390fc 100644 --- a/stdlib/source/test/lux/tool/compiler/meta/archive/registry.lux +++ b/stdlib/source/test/lux/tool/compiler/meta/archive/registry.lux @@ -111,12 +111,12 @@ _ false)))))] - [/.definition (: category.Definition [expected_name {.#None}]) /.definitions category.#Definition /.analyser expected_name] + [/.definition (is category.Definition [expected_name {.#None}]) /.definitions category.#Definition /.analyser expected_name] [/.analyser expected_name /.analysers category.#Analyser /.synthesizer expected_name] [/.synthesizer expected_name /.synthesizers category.#Synthesizer /.generator expected_name] [/.generator expected_name /.generators category.#Generator /.directive expected_name] [/.directive expected_name /.directives category.#Directive /.custom expected_name] - [/.custom expected_name /.customs category.#Custom /.definition (: category.Definition [expected_name {.#None}])] + [/.custom expected_name /.customs category.#Custom /.definition (is category.Definition [expected_name {.#None}])] )) (_.cover [/.id] (and (~~ (template [<new> <expected>' <name>] @@ -126,7 +126,7 @@ (maybe#each (same? @expected)) (maybe.else false)))] - [/.definition (: category.Definition [expected_name {.#None}]) product.left] + [/.definition (is category.Definition [expected_name {.#None}]) product.left] [/.analyser expected_name |>] [/.synthesizer expected_name |>] [/.generator expected_name |>] @@ -136,12 +136,12 @@ (_.cover [/.artifacts] (and (~~ (template [<new> <query> <equivalence> <$>] [(let [expected/* (list#each <$> expected_names) - [ids registry] (: [(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/*)) + [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]]) @@ -149,9 +149,9 @@ (list.zipped/2 (sequence.list ids) (sequence.list it))) (# (list.equivalence <equivalence>) = expected/* (<query> registry))))] - [/.definition /.definitions category.definition_equivalence (: (-> Text category.Definition) - (function (_ it) - [it {.#None}]))] + [/.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 (|>>)] @@ -170,7 +170,7 @@ (maybe.else false))) (try.else false)))] - [/.definition (: category.Definition [expected_name {.#None}]) product.left] + [/.definition (is category.Definition [expected_name {.#None}]) product.left] [/.analyser expected_name |>] [/.synthesizer expected_name |>] [/.generator expected_name |>] 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 700cf75d7..f7e008720 100644 --- a/stdlib/source/test/lux/tool/compiler/meta/cache/purge.lux +++ b/stdlib/source/test/lux/tool/compiler/meta/cache/purge.lux @@ -77,40 +77,40 @@ ($_ _.and (_.cover [/.purge] (and (dictionary.empty? (/.purge (list) (list))) - (let [order (: (dependency.Order Nat) - (list [name/0 id/0 - [archive.#module module/0 - archive.#output (sequence.sequence) - archive.#registry registry.empty]]))] - (and (let [cache (: (List /.Cache) - (list [#1 name/0 id/0 module/0 registry.empty]))] + (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 (: (List /.Cache) - (list [#0 name/0 id/0 module/0 registry.empty]))] + (let [cache (is (List /.Cache) + (list [#0 name/0 id/0 module/0 registry.empty]))] (dictionary.key? (/.purge cache order) name/0)))) - (let [order (: (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 (: (List /.Cache) - (list [#1 name/0 id/0 module/0 registry.empty] - [#1 name/1 id/1 module/1 registry.empty])) + (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 (: (List /.Cache) - (list [#1 name/0 id/0 module/0 registry.empty] - [#0 name/1 id/1 module/1 registry.empty])) + (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 (: (List /.Cache) - (list [#0 name/0 id/0 module/0 registry.empty] - [#1 name/1 id/1 module/1 registry.empty])) + (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))))))) diff --git a/stdlib/source/test/lux/tool/compiler/meta/export.lux b/stdlib/source/test/lux/tool/compiler/meta/export.lux index 82efdf546..d25da0be5 100644 --- a/stdlib/source/test/lux/tool/compiler/meta/export.lux +++ b/stdlib/source/test/lux/tool/compiler/meta/export.lux @@ -44,8 +44,8 @@ source/1 (random.ascii/lower 2) target (random.ascii/lower 3) - .let [random_file (: (Random file.Path) - (# ! each (text.suffix io.lux_extension) (random.ascii/lower 4)))] + .let [random_file (is (Random file.Path) + (# ! each (text.suffix io.lux_extension) (random.ascii/lower 4)))] file/0' random_file .let [file/0 (format source/0 / file/0')] @@ -53,8 +53,8 @@ file/1' (# ! each (|>> (format dir/0 /)) random_file) .let [file/1 (format source/1 / file/1')] - .let [random_content (: (Random Binary) - (# ! each (|>> %.nat (# utf8.codec encoded)) random.nat))] + .let [random_content (is (Random Binary) + (# ! each (|>> %.nat (# utf8.codec encoded)) random.nat))] content/0 random_content content/1 random_content] ($_ _.and diff --git a/stdlib/source/test/lux/tool/compiler/meta/import.lux b/stdlib/source/test/lux/tool/compiler/meta/import.lux index e601614f6..c01a790ce 100644 --- a/stdlib/source/test/lux/tool/compiler/meta/import.lux +++ b/stdlib/source/test/lux/tool/compiler/meta/import.lux @@ -48,15 +48,15 @@ library/1 (random.ascii/lower 2) .let [/ .module_separator - random_file (: (Random file.Path) - (# ! each (text.suffix io.lux_extension) (random.ascii/lower 3)))] + random_file (is (Random file.Path) + (# ! each (text.suffix io.lux_extension) (random.ascii/lower 3)))] file/0 random_file dir/0 (random.ascii/lower 4) file/1 (# ! each (|>> (format dir/0 /)) random_file) - .let [random_content (: (Random Binary) - (# ! each (|>> %.nat (# utf8.codec encoded)) random.nat))] + .let [random_content (is (Random Binary) + (# ! each (|>> %.nat (# utf8.codec encoded)) random.nat))] now random.instant content/0 random_content content/1 random_content @@ -97,17 +97,17 @@ (in (|> (sequence.sequence {tar.#Directory file/0}) (format.result tar.writer)))) (try.else (binary.empty 0))) - imported? (: (-> /.Import Bit) - (function (_ it) - (and (n.= 2 (dictionary.size it)) - (|> it - (dictionary.value file/0) - (maybe#each (binary#= content/0)) - (maybe.else false)) - (|> it - (dictionary.value file/1) - (maybe#each (binary#= content/1)) - (maybe.else false)))))]] + imported? (is (-> /.Import Bit) + (function (_ it) + (and (n.= 2 (dictionary.size it)) + (|> it + (dictionary.value file/0) + (maybe#each (binary#= content/0)) + (maybe.else false)) + (|> it + (dictionary.value file/1) + (maybe#each (binary#= content/1)) + (maybe.else false)))))]] ($_ _.and (in (do [! async.monad] [it/0 (do (try.with !) diff --git a/stdlib/source/test/lux/tool/compiler/phase.lux b/stdlib/source/test/lux/tool/compiler/phase.lux index 19ec57c3c..ced6edd48 100644 --- a/stdlib/source/test/lux/tool/compiler/phase.lux +++ b/stdlib/source/test/lux/tool/compiler/phase.lux @@ -178,12 +178,12 @@ (try#each (same? expected)) (try.else false))) (_.cover [/.composite] - (let [phase (/.composite (: (/.Phase Nat Int Frac) - (function (_ archive input) - (# /.monad in (i.frac input)))) - (: (/.Phase Rev Frac Text) - (function (_ archive input) - (# /.monad in (%.frac input)))))] + (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]} |